aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJosh Rahm <joshuarahm@gmail.com>2022-04-10 13:51:43 -0600
committerJosh Rahm <joshuarahm@gmail.com>2022-04-10 13:51:43 -0600
commit49f20ca3391ca713c021fdf15bf9db3fe54f18f6 (patch)
treeebcf681084eeac0a2c0691c2afca622a7dd8dc3b /src
parentfada61902291aeb29914fff288301a8c487c4ecd (diff)
downloadrde-49f20ca3391ca713c021fdf15bf9db3fe54f18f6.tar.gz
rde-49f20ca3391ca713c021fdf15bf9db3fe54f18f6.tar.bz2
rde-49f20ca3391ca713c021fdf15bf9db3fe54f18f6.zip
More refactoring. Started breaking up Layout. Moved Language extensions into stack file.
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs2
-rw-r--r--src/Rahm/Desktop/Keys.hs5
-rw-r--r--src/Rahm/Desktop/KeysM.hs2
-rw-r--r--src/Rahm/Desktop/Layout/CornerLayout.hs (renamed from src/Rahm/Desktop/CornerLayout.hs)3
-rw-r--r--src/Rahm/Desktop/Layout/Layout.hs (renamed from src/Rahm/Desktop/Layout.hs)51
-rw-r--r--src/Rahm/Desktop/Layout/LayoutDraw.hs (renamed from src/Rahm/Desktop/LayoutDraw.hs)4
-rw-r--r--src/Rahm/Desktop/Layout/LayoutList.hs (renamed from src/Rahm/Desktop/LayoutList.hs)6
-rw-r--r--src/Rahm/Desktop/Layout/ReinterpretMessage.hs48
-rw-r--r--src/Rahm/Desktop/Lib.hs1
-rw-r--r--src/Rahm/Desktop/Marking.hs1
-rw-r--r--src/Rahm/Desktop/MouseMotion.hs1
-rw-r--r--src/Rahm/Desktop/XMobarLog.hs2
12 files changed, 61 insertions, 65 deletions
diff --git a/src/Main.hs b/src/Main.hs
index c8cdd19..86b6fc8 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
+import Rahm.Desktop.Layout.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 9712f84..0bebd6f 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
module Rahm.Desktop.Keys (applyKeys) where
import XMonad.Util.Run (safeSpawn)
@@ -26,7 +25,7 @@ import Data.Char
import Data.List hiding ((!!))
import Data.List.Safe ((!!))
import Data.Map (Map)
-import Rahm.Desktop.Layout
+import Rahm.Desktop.Layout.Layout
import Rahm.Desktop.Marking
import Rahm.Desktop.PromptConfig
import System.IO
@@ -46,7 +45,7 @@ import XMonad.Actions.SpawnOn as SpawnOn
import qualified Data.Map as Map
import qualified XMonad.StackSet as W
-import Rahm.Desktop.LayoutList
+import Rahm.Desktop.Layout.LayoutList
import Rahm.Desktop.MouseMotion
import Rahm.Desktop.Windows
import Rahm.Desktop.Lib
diff --git a/src/Rahm/Desktop/KeysM.hs b/src/Rahm/Desktop/KeysM.hs
index ef52c24..dcbce2a 100644
--- a/src/Rahm/Desktop/KeysM.hs
+++ b/src/Rahm/Desktop/KeysM.hs
@@ -1,5 +1,3 @@
-{-# Language GeneralizedNewtypeDeriving, MultiParamTypeClasses,
- FunctionalDependencies, FlexibleInstances, TypeFamilies, FlexibleContexts #-}
module Rahm.Desktop.KeysM where
import Data.List
diff --git a/src/Rahm/Desktop/CornerLayout.hs b/src/Rahm/Desktop/Layout/CornerLayout.hs
index 33f439e..f0952c7 100644
--- a/src/Rahm/Desktop/CornerLayout.hs
+++ b/src/Rahm/Desktop/Layout/CornerLayout.hs
@@ -1,7 +1,6 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-- Creates a layout, the "corner layout" that keeps the master window in the
-- corner and the other windows go around it.
-module Rahm.Desktop.CornerLayout where
+module Rahm.Desktop.Layout.CornerLayout where
import Data.Typeable (Typeable)
import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage)
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
index 95854b8..93228e7 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -1,10 +1,8 @@
-{-# LANGUAGE MultiParamTypeClasses, ViewPatterns, FlexibleInstances, KindSignatures, DataKinds, GADTs, RankNTypes, PolyKinds #-}
-module Rahm.Desktop.Layout where
+module Rahm.Desktop.Layout.Layout where
import GHC.TypeLits
import Data.Proxy (Proxy(..))
-import Rahm.Desktop.CornerLayout (Corner(..))
import Control.Arrow (second)
import XMonad.Hooks.ManageDocks
import XMonad.Layout.Circle
@@ -25,8 +23,10 @@ import XMonad
import XMonad.Core
import XMonad.Layout.NoBorders (smartBorders, noBorders)
-import Rahm.Desktop.LayoutList
+import Rahm.Desktop.Layout.CornerLayout (Corner(..))
+import Rahm.Desktop.Layout.LayoutList
import Rahm.Desktop.Windows
+import Rahm.Desktop.Layout.ReinterpretMessage
import qualified Data.Map as M
import qualified XMonad.StackSet as W
@@ -46,19 +46,6 @@ myLayout =
mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
nil
--- This is a type class that defines how to reinterpret a message. One can think
--- of this as a kind of type-level function. It lets one associate a function
--- (reinterpretMessage) with a type construct, which for the case below is a
--- Symbol.
---
--- It would be nice to attach this function to the LayoutModifier directly as a
--- value, however LayoutModifiers must be Show-able and Read-able and functions
--- are not. However encoding in the typesystem itsef which function is to be
--- called is the best alternative I have.
-class DoReinterpret (k :: t) where
- reinterpretMessage ::
- Proxy k -> SomeMessage -> X (Maybe SomeMessage)
-
-- 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.
@@ -92,36 +79,6 @@ instance DoReinterpret "IncMasterToResizeMaster" where
else SomeMessage Shrink
reinterpretMessage _ m = return (Just m)
--- Data construct for association a DoReinterpret function with a concrete
--- construct that can be used in the LayoutModifier instance.
---
--- It wolud be nice to have ReinterpretMessage hold the function as a value
--- rather than delegate to this kind-instance, however, it won't work because
--- LayoutModifiers have to be Read-able and Show-able, and functions are neither
--- of those, so a value-level function may not be a member of a LayoutModifier,
--- thus I have to settle for delegating to a hard-coded instance using
--- type-classes.
-data ReinterpretMessage k a = ReinterpretMessage
- deriving (Show, Read)
-
--- Instance for ReinterpretMessage as a Layout modifier.
-instance (DoReinterpret k) =>
- LayoutModifier (ReinterpretMessage k) a where
-
- handleMessOrMaybeModifyIt self message = do
-
- -- Delegates to the reinterpretMessage function associatied with the
- -- type-variable k.
- newMessage <- reinterpretMessage (ofProxy self) message
- case newMessage of
- Just m -> return $ Just $ Right m
- Nothing -> return $ Just $ Left self
- where
- -- ofProxy just provides reifies the phantom type k so the type system can
- -- figure out what instance to go to.
- ofProxy :: ReinterpretMessage k a -> Proxy k
- ofProxy _ = Proxy
-
modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
modifyMosaic = ModifiedLayout ReinterpretMessage
diff --git a/src/Rahm/Desktop/LayoutDraw.hs b/src/Rahm/Desktop/Layout/LayoutDraw.hs
index c3d8c9e..7e59284 100644
--- a/src/Rahm/Desktop/LayoutDraw.hs
+++ b/src/Rahm/Desktop/Layout/LayoutDraw.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
ScopedTypeVariables, BangPatterns #-}
-module Rahm.Desktop.LayoutDraw (drawLayout) where
+module Rahm.Desktop.Layout.LayoutDraw (drawLayout) where
import Control.Monad
@@ -11,7 +11,7 @@ import Control.Monad.Writer (execWriter, tell)
import Data.Foldable (find)
import Data.Maybe (fromMaybe)
import Rahm.Desktop.Hash (quickHash)
-import Rahm.Desktop.Layout (ZoomModifier(..))
+import Rahm.Desktop.Layout.Layout (ZoomModifier(..))
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FilePath ((</>))
import Text.Printf (printf)
diff --git a/src/Rahm/Desktop/LayoutList.hs b/src/Rahm/Desktop/Layout/LayoutList.hs
index 3bc09d3..3e72e99 100644
--- a/src/Rahm/Desktop/LayoutList.hs
+++ b/src/Rahm/Desktop/Layout/LayoutList.hs
@@ -1,6 +1,4 @@
-{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
- FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
- RankNTypes, TupleSections, TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
{-
- This module provides a more powerful version of the "Choose" layout that can
@@ -9,7 +7,7 @@
- The indexing uses a type-safe zipper to keep track of the currently-selected
- layout.
-}
-module Rahm.Desktop.LayoutList (
+module Rahm.Desktop.Layout.LayoutList (
LayoutList,
layoutZipper,
LCons,
diff --git a/src/Rahm/Desktop/Layout/ReinterpretMessage.hs b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
new file mode 100644
index 0000000..98bf779
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
@@ -0,0 +1,48 @@
+module Rahm.Desktop.Layout.ReinterpretMessage where
+
+import XMonad (SomeMessage, X)
+import XMonad.Layout.LayoutModifier (LayoutModifier(..))
+import Data.Proxy (Proxy (..))
+
+-- This is a type class that defines how to reinterpret a message. One can think
+-- of this as a kind of type-level function. It lets one associate a function
+-- (reinterpretMessage) with a type construct, which for the case below is a
+-- Symbol.
+--
+-- It would be nice to attach this function to the LayoutModifier directly as a
+-- value, however LayoutModifiers must be Show-able and Read-able and functions
+-- are not. However encoding in the typesystem itsef which function is to be
+-- called is the best alternative I have.
+class DoReinterpret (k :: t) where
+ reinterpretMessage ::
+ Proxy k -> SomeMessage -> X (Maybe SomeMessage)
+
+-- Data construct for association a DoReinterpret function with a concrete
+-- construct that can be used in the LayoutModifier instance.
+--
+-- It wolud be nice to have ReinterpretMessage hold the function as a value
+-- rather than delegate to this kind-instance, however, it won't work because
+-- LayoutModifiers have to be Read-able and Show-able, and functions are neither
+-- of those, so a value-level function may not be a member of a LayoutModifier,
+-- thus I have to settle for delegating to a hard-coded instance using
+-- type-classes.
+data ReinterpretMessage k a = ReinterpretMessage
+ deriving (Show, Read)
+
+-- Instance for ReinterpretMessage as a Layout modifier.
+instance (DoReinterpret k) =>
+ LayoutModifier (ReinterpretMessage k) a where
+
+ handleMessOrMaybeModifyIt self message = do
+
+ -- Delegates to the reinterpretMessage function associatied with the
+ -- type-variable k.
+ newMessage <- reinterpretMessage (ofProxy self) message
+ case newMessage of
+ Just m -> return $ Just $ Right m
+ Nothing -> return $ Just $ Left self
+ where
+ -- ofProxy just provides reifies the phantom type k so the type system can
+ -- figure out what instance to go to.
+ ofProxy :: ReinterpretMessage k a -> Proxy k
+ ofProxy _ = Proxy
diff --git a/src/Rahm/Desktop/Lib.hs b/src/Rahm/Desktop/Lib.hs
index c90a5d7..2f90d0a 100644
--- a/src/Rahm/Desktop/Lib.hs
+++ b/src/Rahm/Desktop/Lib.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE RankNTypes #-}
module Rahm.Desktop.Lib where
import Prelude hiding ((!!))
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 8e9867d..8ca50fd 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE ScopedTypeVariables #-}
module Rahm.Desktop.Marking (
historyNext, historyPrev,
markCurrentWindow, pushHistory,
diff --git a/src/Rahm/Desktop/MouseMotion.hs b/src/Rahm/Desktop/MouseMotion.hs
index 488f06a..b5e8874 100644
--- a/src/Rahm/Desktop/MouseMotion.hs
+++ b/src/Rahm/Desktop/MouseMotion.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE ViewPatterns, BangPatterns #-}
module Rahm.Desktop.MouseMotion where
import XMonad
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index f3beb86..8b0ad72 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -6,7 +6,7 @@ import Control.Monad.Writer (tell, execWriter)
import Data.List (sortBy)
import Data.Maybe (mapMaybe)
import Data.Ord (comparing)
-import Rahm.Desktop.LayoutDraw (drawLayout)
+import Rahm.Desktop.Layout.LayoutDraw (drawLayout)
import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (spawnPipe)