aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Layout/Bordering.hs
diff options
context:
space:
mode:
authorJosh Rahm <rahm@google.com>2022-11-21 12:05:03 -0700
committerJosh Rahm <rahm@google.com>2022-11-21 12:05:03 -0700
commitee9be16599f20aef6d1d3fd15666c00452f85aba (patch)
tree1aed66c1de2ce201463e3becc2d452d4a8aa2992 /src/Rahm/Desktop/Layout/Bordering.hs
parenta1636c65e05d02f7d4fc408137e1d37b412ce890 (diff)
downloadrde-ee9be16599f20aef6d1d3fd15666c00452f85aba.tar.gz
rde-ee9be16599f20aef6d1d3fd15666c00452f85aba.tar.bz2
rde-ee9be16599f20aef6d1d3fd15666c00452f85aba.zip
Format with ormolu.
Diffstat (limited to 'src/Rahm/Desktop/Layout/Bordering.hs')
-rw-r--r--src/Rahm/Desktop/Layout/Bordering.hs172
1 files changed, 93 insertions, 79 deletions
diff --git a/src/Rahm/Desktop/Layout/Bordering.hs b/src/Rahm/Desktop/Layout/Bordering.hs
index 0a06319..5fb1259 100644
--- a/src/Rahm/Desktop/Layout/Bordering.hs
+++ b/src/Rahm/Desktop/Layout/Bordering.hs
@@ -1,45 +1,61 @@
{-# LANGUAGE DeriveAnyClass #-}
-module Rahm.Desktop.Layout.Bordering
- (Bordering(..), banishToBorder, unbanish, rotateBorderForward,
- rotateBorderBackward, bordering, toggleBanish,
- changeWidth, changeHeight, moveForward, moveBackward) where
-import XMonad
+module Rahm.Desktop.Layout.Bordering
+ ( Bordering (..),
+ banishToBorder,
+ unbanish,
+ rotateBorderForward,
+ rotateBorderBackward,
+ bordering,
+ toggleBanish,
+ changeWidth,
+ changeHeight,
+ moveForward,
+ moveBackward,
+ )
+where
-import Control.Monad
-import Data.Tuple (swap)
import Control.Arrow
+import Control.Monad
+import Data.List (find, partition)
import Data.Map (Map)
-import Data.Maybe (fromMaybe)
import qualified Data.Map as Map
-import Data.List (partition, find)
+import Data.Maybe (fromMaybe)
+import Data.Proxy (Proxy)
import qualified Data.Set as Set
+import Data.Tuple (swap)
import Data.Typeable (cast)
-import Data.Proxy (Proxy)
-
import Rahm.Desktop.Logger
import qualified Rahm.Desktop.StackSet as W
+import XMonad
-data BorderPosition =
- North | NorthEast | East | SouthEast | South | SouthWest | West | NorthWest
+data BorderPosition
+ = North
+ | NorthEast
+ | East
+ | SouthEast
+ | South
+ | SouthWest
+ | West
+ | NorthWest
deriving (Eq, Show, Read, Ord, Enum, Bounded)
-data BorderingData a =
- BorderingData {
- extraWindows :: Map BorderPosition a
- , borderingWidth :: Rational
- , borderingHeight :: Rational
- , borderingPadding :: Int
- } deriving (Eq, Ord, Show, Read)
-
-data Bordering (l :: * -> *) (a :: *) =
- Bordering {
- borderingData :: BorderingData a,
+data BorderingData a = BorderingData
+ { extraWindows :: Map BorderPosition a,
+ borderingWidth :: Rational,
+ borderingHeight :: Rational,
+ borderingPadding :: Int
+ }
+ deriving (Eq, Ord, Show, Read)
+
+data Bordering (l :: * -> *) (a :: *) = Bordering
+ { borderingData :: BorderingData a,
wrappedLayout :: l a
- } deriving (Eq, Ord, Show, Read)
+ }
+ deriving (Eq, Ord, Show, Read)
-data ModifyBordering a =
- ModifyBordering (BorderingData a -> BorderingData a)
+data ModifyBordering a
+ = ModifyBordering (BorderingData a -> BorderingData a)
deriving (Message)
enumNext :: (Eq a, Enum a, Bounded a) => a -> a
@@ -53,40 +69,39 @@ enumPrev a
| otherwise = pred a
bordering :: l a -> Bordering l a
-bordering = Bordering (BorderingData mempty (1/6) (1/6) 10)
+bordering = Bordering (BorderingData mempty (1 / 6) (1 / 6) 10)
banishToBorder :: a -> ModifyBordering a
banishToBorder win =
let allPositions =
- (\(a, b) -> b ++ a) $ break (==SouthEast) [minBound .. maxBound]
- in
- ModifyBordering $ \dat ->
+ (\(a, b) -> b ++ a) $ break (== SouthEast) [minBound .. maxBound]
+ in ModifyBordering $ \dat ->
maybe
dat
- (\pos ->
- dat { extraWindows = Map.insert pos win (extraWindows dat)}) $
- find (not . (`Map.member`extraWindows dat)) allPositions
+ ( \pos ->
+ dat {extraWindows = Map.insert pos win (extraWindows dat)}
+ )
+ $ find (not . (`Map.member` extraWindows dat)) allPositions
toggleBanish :: (Eq a) => a -> ModifyBordering a
toggleBanish win = ModifyBordering $ \dat ->
- let (ModifyBordering fn) =
+ let (ModifyBordering fn) =
if elem win $ Map.elems $ extraWindows dat
then unbanish win
else banishToBorder win
- in fn dat
-
+ in fn dat
unbanish :: (Eq a) => a -> ModifyBordering a
unbanish win =
ModifyBordering $ \dat ->
maybe
dat
- (\pos -> dat { extraWindows = Map.delete pos (extraWindows dat) }) $
- (fst <$> find ((==win) . snd) (Map.toList $ extraWindows dat))
+ (\pos -> dat {extraWindows = Map.delete pos (extraWindows dat)})
+ $ (fst <$> find ((== win) . snd) (Map.toList $ extraWindows dat))
rotateBorder :: (BorderPosition -> BorderPosition) -> ModifyBordering a
rotateBorder next = ModifyBordering $ \dat ->
- dat { extraWindows = Map.mapKeys next (extraWindows dat) }
+ dat {extraWindows = Map.mapKeys next (extraWindows dat)}
rotateBorderForward :: Proxy a -> ModifyBordering a
rotateBorderForward _ = rotateBorder enumNext
@@ -96,45 +111,48 @@ rotateBorderBackward _ = rotateBorder enumPrev
changeWidth :: Proxy a -> Rational -> ModifyBordering a
changeWidth _ amt = ModifyBordering $ \dat ->
- dat { borderingWidth = guard $ borderingWidth dat + amt }
- where guard x | x < 1/12 = 1/12
- | x > 4/12 = 4/12
- | otherwise = x
+ dat {borderingWidth = guard $ borderingWidth dat + amt}
+ where
+ guard x
+ | x < 1 / 12 = 1 / 12
+ | x > 4 / 12 = 4 / 12
+ | otherwise = x
changeHeight :: Proxy a -> Rational -> ModifyBordering a
changeHeight _ amt = ModifyBordering $ \dat ->
- dat { borderingHeight = guard $ borderingHeight dat + amt }
- where guard x | x < 1/12 = 1/12
- | x > 4/12 = 4/12
- | otherwise = x
+ dat {borderingHeight = guard $ borderingHeight dat + amt}
+ where
+ guard x
+ | x < 1 / 12 = 1 / 12
+ | x > 4 / 12 = 4 / 12
+ | otherwise = x
instance Semigroup (ModifyBordering a) where
(<>) = mappend
instance Monoid (ModifyBordering a) where
-
mempty = ModifyBordering id
mappend (ModifyBordering f1) (ModifyBordering f2) = ModifyBordering (f2 . f1)
-
move :: (Eq a) => (BorderPosition -> BorderPosition) -> a -> ModifyBordering a
move fn win = ModifyBordering $ \dat ->
- let mKey = fst <$> find ((==win) . snd) (Map.toList $ extraWindows dat) in
- case mKey of
- Nothing -> dat
- Just key ->
- let newKey = until (\k -> not (Map.member k (extraWindows dat) && k /= key))
- fn (fn key)
- wins' = Map.insert newKey win $ Map.delete key $ extraWindows dat
- in
- dat { extraWindows = wins' }
+ let mKey = fst <$> find ((== win) . snd) (Map.toList $ extraWindows dat)
+ in case mKey of
+ Nothing -> dat
+ Just key ->
+ let newKey =
+ until
+ (\k -> not (Map.member k (extraWindows dat) && k /= key))
+ fn
+ (fn key)
+ wins' = Map.insert newKey win $ Map.delete key $ extraWindows dat
+ in dat {extraWindows = wins'}
moveForward :: (Eq a) => a -> ModifyBordering a
moveForward = move enumNext
moveBackward :: (Eq a) => a -> ModifyBordering a
moveBackward = move enumPrev
-
instance (Show a, Ord a, LayoutClass l a, Typeable a) => LayoutClass (Bordering l) a where
runLayout (W.Workspace t (Bordering dat l) as) rect = do
@@ -145,35 +163,33 @@ instance (Show a, Ord a, LayoutClass l a, Typeable a) => LayoutClass (Bordering
filterStack Nothing = ([], Nothing)
filterStack (Just (W.Stack f h t)) = do
let elSet = Set.fromList (Map.elems $ extraWindows dat)
- ((hp, h'), (tp, t')) = dbl (partition (`Set.member`elSet)) (h, t)
- in case (Set.member f elSet, h', t', hp ++ tp) of
- (False, _, _, r) -> (r, Just $ W.Stack f h' t')
- (True, (a:h''), _, r) -> (f:r, Just $ W.Stack a h'' t')
- (True, [], (a:t''), r) -> (f:r, Just $ W.Stack a [] t'')
- (True, [], [], r) -> (f:r, Nothing)
+ ((hp, h'), (tp, t')) = dbl (partition (`Set.member` elSet)) (h, t)
+ in case (Set.member f elSet, h', t', hp ++ tp) of
+ (False, _, _, r) -> (r, Just $ W.Stack f h' t')
+ (True, (a : h''), _, r) -> (f : r, Just $ W.Stack a h'' t')
+ (True, [], (a : t''), r) -> (f : r, Just $ W.Stack a [] t'')
+ (True, [], [], r) -> (f : r, Nothing)
layoutRest windows =
map (second (scaleRationalRect (padRect rect) . loc2Rect) . swap) $
- filter ((`elem`windows) . snd) $
+ filter ((`elem` windows) . snd) $
Map.toList (extraWindows dat)
padRect (Rectangle x y w h) =
let p :: (Integral a) => a
- p = fromIntegral (borderingPadding dat) in
- Rectangle (x + p) (y + p) (w - p*2) (h - p*2)
+ p = fromIntegral (borderingPadding dat)
+ in Rectangle (x + p) (y + p) (w - p * 2) (h - p * 2)
loc2Rect loc = case loc of
- North -> W.RationalRect (1/2 - (bw / 2)) 0 bw bh
+ North -> W.RationalRect (1 / 2 - (bw / 2)) 0 bw bh
NorthEast -> W.RationalRect (1 - bw) 0 bw bh
- East -> W.RationalRect (1 - bw) (1/2 - (bh / 2)) bw bh
+ East -> W.RationalRect (1 - bw) (1 / 2 - (bh / 2)) bw bh
SouthEast -> W.RationalRect (1 - bw) (1 - bh) bw bh
- South -> W.RationalRect (1/2 - (bw / 2)) (1 - bh) bw bh
+ South -> W.RationalRect (1 / 2 - (bw / 2)) (1 - bh) bw bh
SouthWest -> W.RationalRect 0 (1 - bh) bw bh
- West -> W.RationalRect 0 (1/2 - (bh / 2)) bw bh
+ West -> W.RationalRect 0 (1 / 2 - (bh / 2)) bw bh
NorthWest -> W.RationalRect 0 0 bw bh
-
where
-
bw = borderingWidth dat
bh = borderingHeight dat
@@ -183,12 +199,10 @@ instance (Show a, Ord a, LayoutClass l a, Typeable a) => LayoutClass (Bordering
maybeNewLayout <- handleMessage l m
return $ Just $ Bordering (f d) (fromMaybe l maybeNewLayout)
where
- f e@BorderingData{ extraWindows = ws } =
- e { extraWindows = Map.filter (maybe True (/=w) . cast) ws }
-
+ f e@BorderingData {extraWindows = ws} =
+ e {extraWindows = Map.filter (maybe True (/= w) . cast) ws}
handleMessage (Bordering d l) (fromMessage -> Just (ModifyBordering fn)) =
return (Just $ Bordering (fn d) l)
-
handleMessage (Bordering d l) a = do
maybeNewLayout <- handleMessage l a
return (Bordering d <$> maybeNewLayout)