From 7481428cc081a6e330d35ad01637addcb93c06c7 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 01:05:48 -0600 Subject: Move Rahm.Desktop.Layout.Layout to Rahm.Desktop.Layout --- src/Main.hs | 2 +- src/Rahm/Desktop/Keys.hs | 2 +- src/Rahm/Desktop/Layout.hs | 103 ++++++++++++++++++++++++++++++++++ src/Rahm/Desktop/Layout/Layout.hs | 103 ---------------------------------- src/Rahm/Desktop/Layout/Redescribe.hs | 35 ++++++++++++ 5 files changed, 140 insertions(+), 105 deletions(-) create mode 100644 src/Rahm/Desktop/Layout.hs delete mode 100644 src/Rahm/Desktop/Layout/Layout.hs create mode 100644 src/Rahm/Desktop/Layout/Redescribe.hs (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index 86b6fc8..c8cdd19 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -16,7 +16,7 @@ import Rahm.Desktop.Swallow import Rahm.Desktop.Windows import Rahm.Desktop.XMobarLog import Rahm.Desktop.Keys -import Rahm.Desktop.Layout.Layout +import Rahm.Desktop.Layout import Rahm.Desktop.Logger import Rahm.Desktop.DMenu (menuCommandString) import Rahm.Desktop.RebindKeys diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index c8d9092..e780fbf 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -25,7 +25,7 @@ import Data.Char import Data.List hiding ((!!)) import Data.List.Safe ((!!)) import Data.Map (Map) -import Rahm.Desktop.Layout.Layout +import Rahm.Desktop.Layout import Rahm.Desktop.Marking import Rahm.Desktop.PromptConfig import System.IO diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs new file mode 100644 index 0000000..6c9ac5a --- /dev/null +++ b/src/Rahm/Desktop/Layout.hs @@ -0,0 +1,103 @@ +module Rahm.Desktop.Layout where + +import GHC.TypeLits + +import Data.Proxy (Proxy(..)) +import Control.Arrow (second) +import XMonad.Hooks.ManageDocks +import XMonad.Layout.Circle +import XMonad.Layout.Accordion +import Control.Applicative +import XMonad.Layout.Spacing +import Data.List +import Data.Typeable (cast) +import XMonad.Layout.Spiral +import XMonad.Layout.ThreeColumns +import XMonad.Layout.Grid +import XMonad.Layout.Dishes +import XMonad.Layout.MosaicAlt +import XMonad.Layout.Fullscreen +import qualified XMonad.Layout.Dwindle as D +import XMonad.Layout +import XMonad.Layout.LayoutModifier +import XMonad +import XMonad.Core +import XMonad.Layout.NoBorders (smartBorders, noBorders) + +import Rahm.Desktop.Layout.CornerLayout (Corner(..)) +import Rahm.Desktop.Layout.LayoutList +import Rahm.Desktop.Windows +import Rahm.Desktop.Layout.ReinterpretMessage +import Rahm.Desktop.Layout.Pop +import Rahm.Desktop.Layout.Flip +import Rahm.Desktop.Layout.Rotate +import Rahm.Desktop.Layout.Redescribe + +import qualified Data.Map as M +import qualified XMonad.StackSet as W + +mods = reinterpretResize . poppable . flippable . rotateable + +myLayout = + fullscreenFull $ + avoidStruts $ + spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ + layoutZipper $ + mods (reinterpretIncMaster $ spiral (6/7)) |: + mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |: + mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |: + 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 + +-- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages +-- intended to modify the master space and instead have those messages expand +-- and shrink the current window. +-- +-- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system +-- hacking one can do in Haskell. +instance DoReinterpret "ForMosaic" where + + -- IncMaster message + reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do + fmap (SomeMessage . + (if n > 0 + then expandWindowAlt + else shrinkWindowAlt)) <$> getFocusedWindow + + -- ResizeMaster message + reinterpretMessage _ (fromMessage -> Just m) = do + fmap (SomeMessage . + (case m of + Expand -> expandWindowAlt + Shrink -> shrinkWindowAlt)) <$> getFocusedWindow + + -- Messages that don't match the above, just leave it unmodified. + reinterpretMessage _ m = return (Just m) + +instance DoReinterpret "IncMasterToResizeMaster" where + reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = + return $ Just $ + if n > 0 + then SomeMessage Expand + else SomeMessage Shrink + reinterpretMessage _ m = return (Just m) + +modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a +modifyMosaic = ModifiedLayout ReinterpretMessage + +reinterpretIncMaster :: + l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a +reinterpretIncMaster = ModifiedLayout ReinterpretMessage + +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/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs deleted file mode 100644 index 2719bea..0000000 --- a/src/Rahm/Desktop/Layout/Layout.hs +++ /dev/null @@ -1,103 +0,0 @@ -module Rahm.Desktop.Layout.Layout where - -import GHC.TypeLits - -import Data.Proxy (Proxy(..)) -import Control.Arrow (second) -import XMonad.Hooks.ManageDocks -import XMonad.Layout.Circle -import XMonad.Layout.Accordion -import Control.Applicative -import XMonad.Layout.Spacing -import Data.List -import Data.Typeable (cast) -import XMonad.Layout.Spiral -import XMonad.Layout.ThreeColumns -import XMonad.Layout.Grid -import XMonad.Layout.Dishes -import XMonad.Layout.MosaicAlt -import XMonad.Layout.Fullscreen -import qualified XMonad.Layout.Dwindle as D -import XMonad.Layout -import XMonad.Layout.LayoutModifier -import XMonad -import XMonad.Core -import XMonad.Layout.NoBorders (smartBorders, noBorders) - -import Rahm.Desktop.Layout.CornerLayout (Corner(..)) -import Rahm.Desktop.Layout.LayoutList -import Rahm.Desktop.Windows -import Rahm.Desktop.Layout.ReinterpretMessage -import Rahm.Desktop.Layout.Pop -import Rahm.Desktop.Layout.Flip -import Rahm.Desktop.Layout.Rotate -import Rahm.Desktop.Layout.Redescribe - -import qualified Data.Map as M -import qualified XMonad.StackSet as W - -mods = reinterpretResize . poppable . flippable . rotateable - -myLayout = - fullscreenFull $ - avoidStruts $ - spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ - layoutZipper $ - mods (reinterpretIncMaster $ spiral (6/7)) |: - mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |: - mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |: - 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 - --- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages --- intended to modify the master space and instead have those messages expand --- and shrink the current window. --- --- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system --- hacking one can do in Haskell. -instance DoReinterpret "ForMosaic" where - - -- IncMaster message - reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do - fmap (SomeMessage . - (if n > 0 - then expandWindowAlt - else shrinkWindowAlt)) <$> getFocusedWindow - - -- ResizeMaster message - reinterpretMessage _ (fromMessage -> Just m) = do - fmap (SomeMessage . - (case m of - Expand -> expandWindowAlt - Shrink -> shrinkWindowAlt)) <$> getFocusedWindow - - -- Messages that don't match the above, just leave it unmodified. - reinterpretMessage _ m = return (Just m) - -instance DoReinterpret "IncMasterToResizeMaster" where - reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = - return $ Just $ - if n > 0 - then SomeMessage Expand - else SomeMessage Shrink - reinterpretMessage _ m = return (Just m) - -modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a -modifyMosaic = ModifiedLayout ReinterpretMessage - -reinterpretIncMaster :: - l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a -reinterpretIncMaster = ModifiedLayout ReinterpretMessage - -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/Redescribe.hs b/src/Rahm/Desktop/Layout/Redescribe.hs new file mode 100644 index 0000000..c5c7472 --- /dev/null +++ b/src/Rahm/Desktop/Layout/Redescribe.hs @@ -0,0 +1,35 @@ + +-- Module to enable redescribing layouts. Unlike LayoutModifiers though, this +-- class is aware of the underlying type as it may need to access some internals +-- to generate the new description. +module Rahm.Desktop.Layout.Redescribe where + +import XMonad + +import qualified XMonad.StackSet as W +import Data.Typeable (Typeable) + +-- Type-class to modify the description of a layout. +class Describer m l where + + -- Returns the new description from the given description modifier, the layout + -- and the existing description. + newDescription :: m -> l a -> String -> String + +-- With a DescriptionModifier, +data Redescribe m l a = Redescribe m (l a) + deriving (Show, Read) + +-- Delegates to the underlying Layout, except for the description +instance (Typeable m, Show m, Describer m l, LayoutClass l a) => + LayoutClass (Redescribe m l) a where + + runLayout (W.Workspace t (Redescribe m l) a) rect = do + (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect + return (rects, fmap (Redescribe m) maybeNewLayout) + + handleMessage (Redescribe m l) a = do + maybeNewLayout <- handleMessage l a + return (Redescribe m <$> maybeNewLayout) + + description (Redescribe m l) = newDescription m l (description l) -- cgit