{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.SortedLayout
-- Description :  A layout modifier that sorts a given layout by a list of properties.
-- Copyright   :  (c) 2016 Kurt Dietrich
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  kurto@mac.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- A 'LayoutModifier' that sorts the windows in another layout, given a
-- list of properties. The order of properties in the list determines
-- the order of windows in the final layout. Any unmatched windows
-- go to the end of the order.
-----------------------------------------------------------------------------

module XMonad.Layout.SortedLayout
  ( -- *Usage:
    -- $usage
  sorted
  , Property(..)
  ) where

import           XMonad
import           XMonad.Prelude hiding (Const)
import           XMonad.Layout.LayoutModifier
import           XMonad.StackSet              as W
import           XMonad.Util.WindowProperties

-- $usage
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Layout.SortedLayout
--
-- Then edit your @layoutHook@ to sort another layout (in this case, 'XMonad.Layout.Grid.Grid'):
--
-- > myLayout = sorted [ClassName "Firefox", ClassName "URxvt"] Grid
-- > main = xmonad def { layoutHook = myLayout }
--
-- 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".


-- | Modify a layout using a list of properties to sort its windows.
sorted :: [Property]
       -> l a
       -> ModifiedLayout SortedLayout l a
sorted :: forall (l :: * -> *) a.
[Property] -> l a -> ModifiedLayout SortedLayout l a
sorted [Property]
props = SortedLayout a -> l a -> ModifiedLayout SortedLayout l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (SortedLayout a -> l a -> ModifiedLayout SortedLayout l a)
-> ([Property] -> SortedLayout a)
-> [Property]
-> l a
-> ModifiedLayout SortedLayout l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Property] -> SortedLayout a
forall a. [Property] -> SortedLayout a
SortedLayout ([Property] -> l a -> ModifiedLayout SortedLayout l a)
-> [Property] -> l a -> ModifiedLayout SortedLayout l a
forall a b. (a -> b) -> a -> b
$ [Property]
props [Property] -> [Property] -> [Property]
forall a. [a] -> [a] -> [a]
++ [Bool -> Property
Const Bool
True]

data WindowDescriptor = WindowDescriptor { WindowDescriptor -> Integer
wdSeqn :: !Integer
                                         , WindowDescriptor -> Property
wdProp :: !Property
                                         , WindowDescriptor -> Window
wdId   :: !Window
                                         } deriving (Int -> WindowDescriptor -> ShowS
[WindowDescriptor] -> ShowS
WindowDescriptor -> String
(Int -> WindowDescriptor -> ShowS)
-> (WindowDescriptor -> String)
-> ([WindowDescriptor] -> ShowS)
-> Show WindowDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowDescriptor -> ShowS
showsPrec :: Int -> WindowDescriptor -> ShowS
$cshow :: WindowDescriptor -> String
show :: WindowDescriptor -> String
$cshowList :: [WindowDescriptor] -> ShowS
showList :: [WindowDescriptor] -> ShowS
Show, ReadPrec [WindowDescriptor]
ReadPrec WindowDescriptor
Int -> ReadS WindowDescriptor
ReadS [WindowDescriptor]
(Int -> ReadS WindowDescriptor)
-> ReadS [WindowDescriptor]
-> ReadPrec WindowDescriptor
-> ReadPrec [WindowDescriptor]
-> Read WindowDescriptor
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WindowDescriptor
readsPrec :: Int -> ReadS WindowDescriptor
$creadList :: ReadS [WindowDescriptor]
readList :: ReadS [WindowDescriptor]
$creadPrec :: ReadPrec WindowDescriptor
readPrec :: ReadPrec WindowDescriptor
$creadListPrec :: ReadPrec [WindowDescriptor]
readListPrec :: ReadPrec [WindowDescriptor]
Read)

instance Eq WindowDescriptor where
  == :: WindowDescriptor -> WindowDescriptor -> Bool
(==) WindowDescriptor
a WindowDescriptor
b = WindowDescriptor -> Window
wdId WindowDescriptor
a Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== WindowDescriptor -> Window
wdId WindowDescriptor
b

instance Ord WindowDescriptor where
  compare :: WindowDescriptor -> WindowDescriptor -> Ordering
compare WindowDescriptor
a WindowDescriptor
b = Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (WindowDescriptor -> Integer
wdSeqn WindowDescriptor
a) (WindowDescriptor -> Integer
wdSeqn WindowDescriptor
b)

newtype SortedLayout a = SortedLayout [Property] deriving (Int -> SortedLayout a -> ShowS
[SortedLayout a] -> ShowS
SortedLayout a -> String
(Int -> SortedLayout a -> ShowS)
-> (SortedLayout a -> String)
-> ([SortedLayout a] -> ShowS)
-> Show (SortedLayout a)
forall a. Int -> SortedLayout a -> ShowS
forall a. [SortedLayout a] -> ShowS
forall a. SortedLayout a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> SortedLayout a -> ShowS
showsPrec :: Int -> SortedLayout a -> ShowS
$cshow :: forall a. SortedLayout a -> String
show :: SortedLayout a -> String
$cshowList :: forall a. [SortedLayout a] -> ShowS
showList :: [SortedLayout a] -> ShowS
Show, ReadPrec [SortedLayout a]
ReadPrec (SortedLayout a)
Int -> ReadS (SortedLayout a)
ReadS [SortedLayout a]
(Int -> ReadS (SortedLayout a))
-> ReadS [SortedLayout a]
-> ReadPrec (SortedLayout a)
-> ReadPrec [SortedLayout a]
-> Read (SortedLayout a)
forall a. ReadPrec [SortedLayout a]
forall a. ReadPrec (SortedLayout a)
forall a. Int -> ReadS (SortedLayout a)
forall a. ReadS [SortedLayout a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (SortedLayout a)
readsPrec :: Int -> ReadS (SortedLayout a)
$creadList :: forall a. ReadS [SortedLayout a]
readList :: ReadS [SortedLayout a]
$creadPrec :: forall a. ReadPrec (SortedLayout a)
readPrec :: ReadPrec (SortedLayout a)
$creadListPrec :: forall a. ReadPrec [SortedLayout a]
readListPrec :: ReadPrec [SortedLayout a]
Read)

instance LayoutModifier SortedLayout Window where
    modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
SortedLayout Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout (SortedLayout [Property]
props) = [Property]
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
forall (l :: * -> *).
LayoutClass l Window =>
[Property]
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
sortLayout [Property]
props
    modifierDescription :: SortedLayout Window -> String
modifierDescription SortedLayout Window
_             = String
"Sorted"

findMatchingWindows :: Integer -> Property -> [Window] -> X [WindowDescriptor]
findMatchingWindows :: Integer -> Property -> [Window] -> X [WindowDescriptor]
findMatchingWindows Integer
seqn Property
prop [Window]
wids =  ([Window] -> [WindowDescriptor])
-> X [Window] -> X [WindowDescriptor]
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Window -> WindowDescriptor) -> [Window] -> [WindowDescriptor]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Property -> Window -> WindowDescriptor
WindowDescriptor Integer
seqn Property
prop)) X [Window]
matching  where
  matching :: X [Window]
matching = (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Property -> Window -> X Bool
hasProperty Property
prop) [Window]
wids

sortLayout :: (LayoutClass l Window)
           => [Property]
           -> W.Workspace WorkspaceId (l Window) Window
           -> Rectangle
           -> X ([(Window, Rectangle)], Maybe (l Window))
sortLayout :: forall (l :: * -> *).
LayoutClass l Window =>
[Property]
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
sortLayout [Property]
props (W.Workspace String
w l Window
l Maybe (Stack Window)
r) Rectangle
rect = do
  let wids :: [Window]
wids = Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack Window)
r
  [Window]
sortedWids <- (WindowDescriptor -> Window) -> [WindowDescriptor] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map WindowDescriptor -> Window
wdId ([WindowDescriptor] -> [Window])
-> ([[WindowDescriptor]] -> [WindowDescriptor])
-> [[WindowDescriptor]]
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowDescriptor] -> [WindowDescriptor]
forall a. Eq a => [a] -> [a]
nub ([WindowDescriptor] -> [WindowDescriptor])
-> ([[WindowDescriptor]] -> [WindowDescriptor])
-> [[WindowDescriptor]]
-> [WindowDescriptor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowDescriptor] -> [WindowDescriptor]
forall a. Ord a => [a] -> [a]
sort ([WindowDescriptor] -> [WindowDescriptor])
-> ([[WindowDescriptor]] -> [WindowDescriptor])
-> [[WindowDescriptor]]
-> [WindowDescriptor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[WindowDescriptor]] -> [WindowDescriptor]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[WindowDescriptor]] -> [Window])
-> X [[WindowDescriptor]] -> X [Window]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Property -> X [WindowDescriptor])
-> [Integer] -> [Property] -> X [[WindowDescriptor]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Integer
s Property
p -> Integer -> Property -> [Window] -> X [WindowDescriptor]
findMatchingWindows Integer
s Property
p [Window]
wids) [Integer
0..] [Property]
props
  let sr :: Maybe (Stack Window)
sr = [Window] -> Maybe (Stack Window)
forall a. [a] -> Maybe (Stack a)
W.differentiate [Window]
sortedWids
  Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l Window
-> Maybe (Stack Window)
-> Workspace String (l Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
w l Window
l Maybe (Stack Window)
sr) Rectangle
rect