Remove some layout bloat.

Remove a bunch of esentially-unused layouts. Now the layouts are:

  - Spiral
  - Mosaic
  - Tall

4 files changed, 37 insertions, 312 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 8ed0b06..6b484e5 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -27,7 +27,6 @@ import Rahm.Desktop.History
 import Rahm.Desktop.Keys.Dsl
 import Rahm.Desktop.Keys.Wml
 import Rahm.Desktop.Layout
-import Rahm.Desktop.Layout.Bordering
 import Rahm.Desktop.Layout.ConsistentMosaic
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Hole (toggleHole)
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index 0bfc0a3..fdbfc79 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -1,39 +1,43 @@
-module Rahm.Desktop.Layout where
+module Rahm.Desktop.Layout
+  ( myLayout,
+    myLayoutList,
+    nLayouts,
+  )
+where
 
-import Control.Applicative
-import Control.Arrow (second)
-import Data.List
-import qualified Data.Map as M
-import Data.Proxy (Proxy (..))
-import Data.Typeable (cast)
-import GHC.TypeLits
-import Rahm.Desktop.Layout.Bordering
 import Rahm.Desktop.Layout.ConsistentMosaic
-import Rahm.Desktop.Layout.CornerLayout (Corner (..))
-import Rahm.Desktop.Layout.Flip
-import Rahm.Desktop.Layout.Hole
+  ( MosaicWrap (..),
+    expandPositionAlt,
+    shrinkPositionAlt,
+  )
+import Rahm.Desktop.Layout.Flip (flippable)
+import Rahm.Desktop.Layout.Hole (hole)
 import Rahm.Desktop.Layout.List
-import Rahm.Desktop.Layout.Pop
-import Rahm.Desktop.Layout.Redescribe
-import Rahm.Desktop.Layout.ReinterpretMessage
-import Rahm.Desktop.Layout.Rotate
-import qualified Rahm.Desktop.StackSet as W
+  ( layoutList,
+    layoutListLength,
+    nil,
+    (|:),
+  )
+import Rahm.Desktop.Layout.Pop (poppable)
+import Rahm.Desktop.Layout.Redescribe (Describer (..), Redescribe (..))
+import Rahm.Desktop.Layout.ReinterpretMessage (DoReinterpret (..), ReinterpretMessage (..))
+import Rahm.Desktop.Layout.Rotate (rotateable)
 import XMonad
-import XMonad.Core
-import XMonad.Hooks.ManageDocks
-import XMonad.Layout
-import XMonad.Layout.Accordion
-import XMonad.Layout.Circle
-import XMonad.Layout.Dishes
-import qualified XMonad.Layout.Dwindle as D
-import XMonad.Layout.Fullscreen
-import XMonad.Layout.Grid
-import XMonad.Layout.LayoutModifier
+  ( IncMasterN (..),
+    Resize (..),
+    SomeMessage (..),
+    Tall (..),
+    Window,
+    fromMessage,
+  )
+import XMonad.Hooks.ManageDocks (avoidStruts)
+import XMonad.Layout.Fullscreen (fullscreenFull)
+import XMonad.Layout.LayoutModifier (ModifiedLayout (..))
 import XMonad.Layout.MosaicAlt
-import XMonad.Layout.NoBorders (noBorders, smartBorders)
-import XMonad.Layout.Spacing
-import XMonad.Layout.Spiral
-import XMonad.Layout.ThreeColumns
+  ( MosaicAlt (..),
+  )
+import XMonad.Layout.Spacing (Border (..), spacingRaw)
+import XMonad.Layout.Spiral (spiral)
 
 myLayout =
   fullscreenFull $
@@ -42,18 +46,13 @@ myLayout =
 mySpacing = spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True
 
 mods =
-  bordering . mySpacing . poppable . flippable . rotateable . hole
+  mySpacing . poppable . flippable . rotateable . hole
 
 myLayoutList =
   layoutList $
     mods (reinterpretIncMaster $ spiral (6 / 7))
-      |: mods (MosaicWrap $ modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window))
-      |: mods (reinterpretIncMaster $ Corner (3 / 4) (3 / 100))
+      |: mods (MosaicWrap $ modifyMosaic (MosaicAlt mempty :: MosaicAlt Window))
       |: mods (Redescribe UsingTall (Tall 1 (3 / 100) (1 / 2)))
-      |: mods (Redescribe UsingThreeCol (ThreeCol 1 (3 / 100) (1 / 2)))
-      |: mods Grid
-      |: mods (Dishes 2 (1 / 6))
-      |: mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1)
       |: nil
 
 nLayouts :: Int
@@ -105,9 +104,3 @@ data UsingTall = UsingTall deriving (Read, Show)
 
 instance Describer UsingTall Tall where
   newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
-
-data UsingThreeCol = UsingThreeCol deriving (Read, Show)
-
-instance Describer UsingThreeCol ThreeCol where
-  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
-  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
diff --git a/src/Rahm/Desktop/Layout/Bordering.hs b/src/Rahm/Desktop/Layout/Bordering.hs
deleted file mode 100644
index 5fb1259..0000000
--- a/src/Rahm/Desktop/Layout/Bordering.hs
+++ /dev/null
@@ -1,208 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-
-module Rahm.Desktop.Layout.Bordering
-  ( Bordering (..),
-    banishToBorder,
-    unbanish,
-    rotateBorderForward,
-    rotateBorderBackward,
-    bordering,
-    toggleBanish,
-    changeWidth,
-    changeHeight,
-    moveForward,
-    moveBackward,
-  )
-where
-
-import Control.Arrow
-import Control.Monad
-import Data.List (find, partition)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
-import Data.Proxy (Proxy)
-import qualified Data.Set as Set
-import Data.Tuple (swap)
-import Data.Typeable (cast)
-import Rahm.Desktop.Logger
-import qualified Rahm.Desktop.StackSet as W
-import XMonad
-
-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,
-    wrappedLayout :: l a
-  }
-  deriving (Eq, Ord, Show, Read)
-
-data ModifyBordering a
-  = ModifyBordering (BorderingData a -> BorderingData a)
-  deriving (Message)
-
-enumNext :: (Eq a, Enum a, Bounded a) => a -> a
-enumNext a
-  | a == maxBound = minBound
-  | otherwise = succ a
-
-enumPrev :: (Eq a, Enum a, Bounded a) => a -> a
-enumPrev a
-  | a == minBound = maxBound
-  | otherwise = pred a
-
-bordering :: l a -> Bordering l a
-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 ->
-        maybe
-          dat
-          ( \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) =
-        if elem win $ Map.elems $ extraWindows dat
-          then unbanish win
-          else banishToBorder win
-   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))
-
-rotateBorder :: (BorderPosition -> BorderPosition) -> ModifyBordering a
-rotateBorder next = ModifyBordering $ \dat ->
-  dat {extraWindows = Map.mapKeys next (extraWindows dat)}
-
-rotateBorderForward :: Proxy a -> ModifyBordering a
-rotateBorderForward _ = rotateBorder enumNext
-
-rotateBorderBackward :: Proxy a -> ModifyBordering a
-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
-
-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
-
-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'}
-
-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
-    let (out, rest) = filterStack as
-    (rects, maybeNewLayout) <- runLayout (W.Workspace t l rest) rect
-    return (layoutRest out ++ rects, Bordering dat <$> maybeNewLayout)
-    where
-      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)
-
-      layoutRest windows =
-        map (second (scaleRationalRect (padRect rect) . loc2Rect) . swap) $
-          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)
-
-      loc2Rect loc = case loc of
-        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
-        SouthEast -> W.RationalRect (1 - bw) (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
-        NorthWest -> W.RationalRect 0 0 bw bh
-        where
-          bw = borderingWidth dat
-          bh = borderingHeight dat
-
-      dbl f = f *** f
-
-  handleMessage (Bordering d l) m@(fromMessage -> Just e@DestroyWindowEvent {ev_window = w}) = do
-    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}
-  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)
diff --git a/src/Rahm/Desktop/Layout/CornerLayout.hs b/src/Rahm/Desktop/Layout/CornerLayout.hs
deleted file mode 100644
index f87d9fa..0000000
--- a/src/Rahm/Desktop/Layout/CornerLayout.hs
+++ /dev/null
@@ -1,59 +0,0 @@
--- Creates a layout, the "corner layout" that keeps the master window in the
--- corner and the other windows go around it.
-module Rahm.Desktop.Layout.CornerLayout where
-
-import Data.Typeable (Typeable)
-import qualified Rahm.Desktop.StackSet as S
-import XMonad (LayoutClass (..), Rectangle (..), Resize (..), fromMessage)
-
-data Corner a = Corner Rational Rational
-  deriving (Show, Typeable, Read)
-
-instance LayoutClass Corner a where
-  pureLayout (Corner frac _) screen@(Rectangle x y w h) ss =
-    let w' = floor $ fromIntegral w * frac
-        h' = floor $ fromIntegral h * frac
-        corner = Rectangle 0 0 w' h'
-        vertRect = Rectangle (fromIntegral w') 0 (w - w') h
-        horizRect = Rectangle 0 (fromIntegral h') w' (h - h')
-        ws = S.integrate ss
-
-        vn = (length ws - 1) `div` 2
-        hn = (length ws - 1) - vn
-     in case ws of
-          [a] -> [(a, screen)]
-          [a, b] ->
-            [ (a, Rectangle x y w' h),
-              (b, Rectangle (x + fromIntegral w') y (w - w') h)
-            ]
-          _ ->
-            zip ws $
-              map
-                ( \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h
-                )
-                $ corner :
-                splitVert vertRect vn
-                  ++ splitHoriz horizRect hn
-
-  pureMessage (Corner frac delta) m = fmap resize (fromMessage m)
-    where
-      resize Shrink = Corner (frac - delta) delta
-      resize Expand = Corner (frac + delta) delta
-
-splitVert :: Rectangle -> Int -> [Rectangle]
-splitVert (Rectangle x y w h) i' =
-  map
-    (\i -> Rectangle x (y + fromIntegral (step * i)) w step)
-    [0 .. i - 1]
-  where
-    i = fromIntegral i'
-    step = h `div` i
-
-splitHoriz :: Rectangle -> Int -> [Rectangle]
-splitHoriz (Rectangle x y w h) i' =
-  map
-    (\i -> Rectangle (x + fromIntegral (step * i)) y step h)
-    [0 .. i - 1]
-  where
-    step = w `div` i
-    i = fromIntegral i'