module XMonad.Actions.SwapPromote
(
MasterHistory (..)
, getMasterHistoryMap
, getMasterHistoryFromTag
, getMasterHistoryCurrent
, getMasterHistoryFromWindow
, modifyMasterHistoryFromTag
, modifyMasterHistoryCurrent
, masterHistoryHook
, masterHistoryHook'
, updateMasterHistory
, swapPromote
, swapPromote'
, swapIn
, swapIn'
, swapHybrid
, swapHybrid'
, swapApply
, swapPromoteStack
, swapInStack
, swapHybridStack
, cycleN
, split
, split'
, merge
, merge'
, stackSplit
, stackMerge
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Arrow
import qualified Data.List.NonEmpty as NE
newtype MasterHistory = MasterHistory
{ MasterHistory -> Map WorkspaceId [Window]
getMasterHistory :: M.Map WorkspaceId [Window]
} deriving (ReadPrec [MasterHistory]
ReadPrec MasterHistory
Int -> ReadS MasterHistory
ReadS [MasterHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MasterHistory]
$creadListPrec :: ReadPrec [MasterHistory]
readPrec :: ReadPrec MasterHistory
$creadPrec :: ReadPrec MasterHistory
readList :: ReadS [MasterHistory]
$creadList :: ReadS [MasterHistory]
readsPrec :: Int -> ReadS MasterHistory
$creadsPrec :: Int -> ReadS MasterHistory
Read,Int -> MasterHistory -> ShowS
[MasterHistory] -> ShowS
MasterHistory -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [MasterHistory] -> ShowS
$cshowList :: [MasterHistory] -> ShowS
show :: MasterHistory -> WorkspaceId
$cshow :: MasterHistory -> WorkspaceId
showsPrec :: Int -> MasterHistory -> ShowS
$cshowsPrec :: Int -> MasterHistory -> ShowS
Show)
instance ExtensionClass MasterHistory where
initialValue :: MasterHistory
initialValue = Map WorkspaceId [Window] -> MasterHistory
MasterHistory forall k a. Map k a
M.empty
getMasterHistoryMap :: X (M.Map WorkspaceId [Window])
getMasterHistoryMap :: X (Map WorkspaceId [Window])
getMasterHistoryMap = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets MasterHistory -> Map WorkspaceId [Window]
getMasterHistory
getMasterHistoryFromTag :: WorkspaceId -> X [Window]
getMasterHistoryFromTag :: WorkspaceId -> X [Window]
getMasterHistoryFromTag WorkspaceId
t = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] WorkspaceId
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Map WorkspaceId [Window])
getMasterHistoryMap
getMasterHistoryCurrent :: X [Window]
getMasterHistoryCurrent :: X [Window]
getMasterHistoryCurrent = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X [Window]
getMasterHistoryFromTag
getMasterHistoryFromWindow :: Window -> X [Window]
getMasterHistoryFromWindow :: Window -> X [Window]
getMasterHistoryFromWindow Window
w = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return []) WorkspaceId -> X [Window]
getMasterHistoryFromTag
modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
modifyMasterHistoryFromTag WorkspaceId
t [Window] -> [Window]
f = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ \(MasterHistory Map WorkspaceId [Window]
m) ->
let l :: [Window]
l = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] WorkspaceId
t Map WorkspaceId [Window]
m
in Map WorkspaceId [Window] -> MasterHistory
MasterHistory forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
t ([Window] -> [Window]
f [Window]
l) Map WorkspaceId [Window]
m
modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
modifyMasterHistoryCurrent [Window] -> [Window]
f = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> ([Window] -> [Window]) -> X ()
modifyMasterHistoryFromTag [Window] -> [Window]
f
masterHistoryHook :: X ()
masterHistoryHook :: X ()
masterHistoryHook = Bool -> ([Window] -> [Window] -> [Window]) -> X ()
masterHistoryHook' Bool
True [Window] -> [Window] -> [Window]
updateMasterHistory
masterHistoryHook' :: Bool
-> ([Window] -> [Window] -> [Window])
-> X ()
masterHistoryHook' :: Bool -> ([Window] -> [Window] -> [Window]) -> X ()
masterHistoryHook' Bool
removeWorkspaces [Window] -> [Window] -> [Window]
historyModifier = do
WindowSet
wset <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let W.Workspace WorkspaceId
wid Layout Window
_ Maybe (Stack Window)
mst = 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 forall a b. (a -> b) -> a -> b
$ WindowSet
wset
tags :: [WorkspaceId]
tags = forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
W.tag forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
wset
st :: [Window]
st = forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack Window)
mst
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ \(MasterHistory Map WorkspaceId [Window]
mm) ->
let mm' :: Map WorkspaceId [Window]
mm' = if Bool
removeWorkspaces
then forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys Map WorkspaceId [Window]
mm forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [WorkspaceId]
tags
else Map WorkspaceId [Window]
mm
ms :: [Window]
ms = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] WorkspaceId
wid Map WorkspaceId [Window]
mm'
ms' :: [Window]
ms' = [Window] -> [Window] -> [Window]
historyModifier [Window]
ms [Window]
st
in Map WorkspaceId [Window] -> MasterHistory
MasterHistory forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
wid [Window]
ms' Map WorkspaceId [Window]
mm'
restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a
restrictKeys :: forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys Map k a
m Set k
s = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\k
k a
_ -> k
k forall a. Ord a => a -> Set a -> Bool
`S.member` Set k
s) Map k a
m
updateMasterHistory :: [Window]
-> [Window]
-> [Window]
updateMasterHistory :: [Window] -> [Window] -> [Window]
updateMasterHistory [Window]
_ [] = []
updateMasterHistory [Window]
ms ws :: [Window]
ws@(Window
w:[Window]
_) = (Window
w forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [a]
delete Window
w [Window]
ms) forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Window]
ws
swapPromote :: Bool -> X Bool
swapPromote :: Bool -> X Bool
swapPromote = forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool
-> (Maybe Window -> Stack Window -> (Bool, Stack Window)) -> X Bool
swapApply Maybe Window -> Stack Window -> (Bool, Stack Window)
swapPromoteStack
swapPromote' :: Bool -> X ()
swapPromote' :: Bool -> X ()
swapPromote' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> X Bool
swapPromote
swapIn :: Bool -> X Bool
swapIn :: Bool -> X Bool
swapIn = forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool
-> (Maybe Window -> Stack Window -> (Bool, Stack Window)) -> X Bool
swapApply Maybe Window -> Stack Window -> (Bool, Stack Window)
swapInStack
swapIn' :: Bool -> X ()
swapIn' :: Bool -> X ()
swapIn' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> X Bool
swapIn
swapHybrid :: Bool -> X Bool
swapHybrid :: Bool -> X Bool
swapHybrid = forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool
-> (Maybe Window -> Stack Window -> (Bool, Stack Window)) -> X Bool
swapApply Maybe Window -> Stack Window -> (Bool, Stack Window)
swapHybridStack
swapHybrid' :: Bool -> X ()
swapHybrid' :: Bool -> X ()
swapHybrid' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> X Bool
swapHybrid
swapApply :: Bool
-> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))
-> X Bool
swapApply :: Bool
-> (Maybe Window -> Stack Window -> (Bool, Stack Window)) -> X Bool
swapApply Bool
ignoreFloats Maybe Window -> Stack Window -> (Bool, Stack Window)
swapFunction = do
Map Window RationalRect
fl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
Maybe (Stack Window)
st <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
[Window]
ch <- X [Window]
getMasterHistoryCurrent
let swapApply' :: Stack Window -> (Bool, Maybe (Stack Window), b -> [Window])
swapApply' Stack Window
s1 =
let fl' :: Set Window
fl' = if Bool
ignoreFloats then forall k a. Map k a -> Set k
M.keysSet Map Window RationalRect
fl else forall a. Set a
S.empty
ff :: Window -> Bool
ff = Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Window
fl') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Eq a => a -> a -> Bool
== forall a. Stack a -> a
W.focus Stack Window
s1)
fh :: [Window]
fh = forall a. (a -> Bool) -> [a] -> [a]
filter Window -> Bool
ff [Window]
ch
pm :: Maybe Window
pm = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ [Window]
fh
([(Int, Window)]
r,Stack Window
s2) = forall a b.
(Num a, Enum a, Ord b) =>
Stack b -> Set b -> ([(a, b)], Stack b)
stackSplit Stack Window
s1 Set Window
fl' :: ([(Int,Window)],W.Stack Window)
(Bool
b,Stack Window
s3) = Maybe Window -> Stack Window -> (Bool, Stack Window)
swapFunction Maybe Window
pm Stack Window
s2
s4 :: Stack Window
s4 = forall a b. (Ord a, Num a) => Stack b -> [(a, b)] -> Stack b
stackMerge Stack Window
s3 [(Int, Window)]
r
mh :: b -> [Window]
mh = let w :: Window
w = forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => [a] -> NonEmpty a
notEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
W.integrate forall a b. (a -> b) -> a -> b
$ Stack Window
s3
in forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Window
w forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [a]
delete Window
w [Window]
ch
in (Bool
b,forall a. a -> Maybe a
Just Stack Window
s4,forall {b}. b -> [Window]
mh)
(Bool
x,Maybe (Stack Window)
y,[Window] -> [Window]
z) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False,forall a. Maybe a
Nothing,forall a. a -> a
id) forall {b}.
Stack Window -> (Bool, Maybe (Stack Window), b -> [Window])
swapApply' Maybe (Stack Window)
st
([Window] -> [Window]) -> X ()
modifyMasterHistoryCurrent [Window] -> [Window]
z
(WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
W.modify forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window)
y
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x
swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapPromoteStack :: Maybe Window -> Stack Window -> (Bool, Stack Window)
swapPromoteStack Maybe Window
_ st :: Stack Window
st@(W.Stack Window
_x [] []) = (Bool
False,Stack Window
st)
swapPromoteStack Maybe Window
Nothing st :: Stack Window
st@(W.Stack Window
_x [] [Window]
_r) = (Bool
True,Stack Window
st)
swapPromoteStack (Just Window
pm) (W.Stack Window
x [] [Window]
r) =
let ([Window]
r',[Window]
l') = (forall a. [a] -> [a]
reverse forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. Int -> [a] -> [a]
cycleN Int
1) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Window
pm) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Window]
r
st' :: Stack Window
st' = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x [Window]
l' [Window]
r'
b :: Bool
b = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
l'
in (Bool
b,Stack Window
st')
swapPromoteStack Maybe Window
_ (W.Stack Window
x [Window]
l [Window]
r) =
let r' :: [Window]
r' = (forall a. [a] -> [a] -> [a]
++ [Window]
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
cycleN Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Window]
l
st' :: Stack Window
st' = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x [] [Window]
r'
in (Bool
False,Stack Window
st')
swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapInStack :: Maybe Window -> Stack Window -> (Bool, Stack Window)
swapInStack Maybe Window
_ st :: Stack Window
st@(W.Stack Window
_x [] []) = (Bool
False,Stack Window
st)
swapInStack Maybe Window
Nothing st :: Stack Window
st@(W.Stack Window
_x [] [Window]
_r) = (Bool
True,Stack Window
st)
swapInStack (Just Window
pm) (W.Stack Window
x [] [Window]
r) =
let (Window
x',[Window]
r') = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Window
pm) [Window]
r of
([Window]
__,[]) -> (Window
x,[Window]
r)
([Window]
sl,[Window]
sr) -> (Window
pm,[Window]
sl forall a. [a] -> [a] -> [a]
++ Window
x forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
drop Int
1 [Window]
sr)
st' :: Stack Window
st' = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x' [] [Window]
r'
b :: Bool
b = Window
x' forall a. Eq a => a -> a -> Bool
== Window
x
in (Bool
b,Stack Window
st')
swapInStack Maybe Window
_ (W.Stack Window
x [Window]
l [Window]
r) =
let l' :: [Window]
l' = forall a. [a] -> [a]
init [Window]
l forall a. [a] -> [a] -> [a]
++ [Window
x]
x' :: Window
x' = forall a. [a] -> a
last [Window]
l
st' :: Stack Window
st' = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x' [Window]
l' [Window]
r
in (Bool
False,Stack Window
st')
swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapHybridStack :: Maybe Window -> Stack Window -> (Bool, Stack Window)
swapHybridStack Maybe Window
m st :: Stack Window
st@(W.Stack Window
_ [] [Window]
_) = Maybe Window -> Stack Window -> (Bool, Stack Window)
swapInStack Maybe Window
m Stack Window
st
swapHybridStack Maybe Window
m Stack Window
st = Maybe Window -> Stack Window -> (Bool, Stack Window)
swapPromoteStack Maybe Window
m Stack Window
st
cycleN :: Int -> [a] -> [a]
cycleN :: forall a. Int -> [a] -> [a]
cycleN Int
n [a]
ls =
let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls
in forall a. Int -> [a] -> [a]
take Int
l forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (Int
n forall a. Integral a => a -> a -> a
`mod` Int
l) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [a]
ls
split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])
split :: forall a b.
(Num a, Enum a) =>
(b -> Bool) -> [b] -> ([(a, b)], [b])
split b -> Bool
p [b]
l =
let (a
_,[(a, b)]
ys,[b]
ns) = forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' b -> Bool
p a
0 [b]
l
in ([(a, b)]
ys,[b]
ns)
split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])
split' :: forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' b -> Bool
p a
i [b]
l =
let accumulate :: (a, b) -> (a, [(a, b)], [(a, b)]) -> (a, [(a, b)], [(a, b)])
accumulate (a, b)
e (a
c,[(a, b)]
ys,[(a, b)]
ns) = if b -> Bool
p (forall a b. (a, b) -> b
snd (a, b)
e)
then (a
cforall a. Num a => a -> a -> a
+a
1,(a, b)
eforall a. a -> [a] -> [a]
:[(a, b)]
ys,[(a, b)]
ns)
else (a
cforall a. Num a => a -> a -> a
+a
1,[(a, b)]
ys,(a, b)
eforall a. a -> [a] -> [a]
:[(a, b)]
ns)
(a
c',[(a, b)]
ys',[(a, b)]
ns') = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}.
Num a =>
(a, b) -> (a, [(a, b)], [(a, b)]) -> (a, [(a, b)], [(a, b)])
accumulate (a
0,[],[]) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [a
i..] [b]
l
in (a
c',[(a, b)]
ys',forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
ns')
merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]
merge :: forall a b. (Ord a, Num a) => [(a, b)] -> [b] -> [b]
merge [(a, b)]
il [b]
ul =
let (a
_,[(a, b)]
il',[b]
ul') = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' a
0 [(a, b)]
il [b]
ul
in [b]
ul' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
il'
merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])
merge' :: forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' a
i il :: [(a, b)]
il@((a
j,b
a):[(a, b)]
ps) ul :: [b]
ul@(b
b:[b]
bs) = if a
j forall a. Ord a => a -> a -> Bool
<= a
i
then let (a
x,[(a, b)]
y,[b]
z) = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [(a, b)]
ps [b]
ul
in (a
x,[(a, b)]
y,b
aforall a. a -> [a] -> [a]
:[b]
z)
else let (a
x,[(a, b)]
y,[b]
z) = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [(a, b)]
il [b]
bs
in (a
x,[(a, b)]
y,b
bforall a. a -> [a] -> [a]
:[b]
z)
merge' a
i [] (b
b:[b]
bs) =
let (a
x,[(a, b)]
y,[b]
z) = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [] [b]
bs
in (a
x,[(a, b)]
y,b
bforall a. a -> [a] -> [a]
:[b]
z)
merge' a
i il :: [(a, b)]
il@((a
j,b
a):[(a, b)]
ps) [] = if a
j forall a. Ord a => a -> a -> Bool
<= a
i
then let (a
x,[(a, b)]
y,[b]
z) = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [(a, b)]
ps []
in (a
x,[(a, b)]
y,b
aforall a. a -> [a] -> [a]
:[b]
z)
else (a
i,[(a, b)]
il,[])
merge' a
i [] [] =
(a
i,[],[])
stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)
stackSplit :: forall a b.
(Num a, Enum a, Ord b) =>
Stack b -> Set b -> ([(a, b)], Stack b)
stackSplit (W.Stack b
x [b]
l [b]
r) Set b
s =
let (a
c,[(a, b)]
fl,[b]
tl) = forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' (forall a. Ord a => a -> Set a -> Bool
`S.member` Set b
s) a
0 (forall a. [a] -> [a]
reverse [b]
l)
(a
_,[(a, b)]
fr,[b]
tr) = forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' (forall a. Ord a => a -> Set a -> Bool
`S.member` Set b
s) (a
cforall a. Num a => a -> a -> a
+a
1) [b]
r
in ([(a, b)]
flforall a. [a] -> [a] -> [a]
++[(a, b)]
fr,forall a. a -> [a] -> [a] -> Stack a
W.Stack b
x (forall a. [a] -> [a]
reverse [b]
tl) [b]
tr)
stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b
stackMerge :: forall a b. (Ord a, Num a) => Stack b -> [(a, b)] -> Stack b
stackMerge (W.Stack b
x [b]
l [b]
r) [(a, b)]
il =
let (a
i,[(a, b)]
il1,[b]
l') = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' a
0 [(a, b)]
il (forall a. [a] -> [a]
reverse [b]
l)
(a
_,[(a, b)]
il2,[b]
r') = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [(a, b)]
il1 [b]
r
in forall a. a -> [a] -> [a] -> Stack a
W.Stack b
x (forall a. [a] -> [a]
reverse [b]
l') ([b]
r' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
il2)