aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Common.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop/Common.hs')
-rw-r--r--src/Rahm/Desktop/Common.hs40
1 files changed, 21 insertions, 19 deletions
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 993726b..47156bb 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -19,20 +19,20 @@ module Rahm.Desktop.Common
)
where
-import Rahm.Desktop.Logger
-import Data.Void (absurd, Void (..))
-import Data.Either (either)
import Control.Applicative ((<*))
import Control.Monad (forM_, void, when)
-import Control.Monad.Trans.Maybe (MaybeT (..))
-import Control.Monad.Trans.Identity (IdentityT (..))
-import Control.Monad.Trans.Except (runExceptT, ExceptT (..), catchE, throwE)
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except (ExceptT (..), catchE, runExceptT, throwE)
+import Control.Monad.Trans.Identity (IdentityT (..))
+import Control.Monad.Trans.Maybe (MaybeT (..))
import Data.Char (toLower)
+import Data.Either (either)
import Data.List (concatMap, head, isInfixOf, map, (++))
import qualified Data.Map as Map (fromListWith)
import Data.Maybe (Maybe (..), maybe)
+import Data.Void (Void (..), absurd)
import Rahm.Desktop.DMenu (runDMenuPromptWithMap)
+import Rahm.Desktop.Logger
import qualified Rahm.Desktop.StackSet as S
( Screen (Screen, workspace),
StackSet (StackSet, current),
@@ -127,24 +127,26 @@ windowJump = mapM_ (focus . head) =<< askWindowId
-- Have to add a definition because Stack uses an ancient version of
-- transformers for some reason.
-myFinallyE :: Monad m => ExceptT e m a -> ExceptT e m () -> ExceptT e m a
+myFinallyE :: (Monad m) => ExceptT e m a -> ExceptT e m () -> ExceptT e m a
myFinallyE m closer = catchE (m <* closer) (\e -> closer >> throwE e)
-- Temporarily set the border color of the given windows.
withBorderColorE :: String -> [Window] -> ExceptT e X a -> ExceptT e X a
withBorderColorE color wins fn = do
d <- lift $ asks display
- (px, oPx, fPx) <- lift $
- (,,)
- <$> stringToPixel d color
- <*> (stringToPixel d =<< asks (normalBorderColor . config))
- <*> (stringToPixel d =<< asks (focusedBorderColor . config))
-
- (colorName, oColorName, fColorName) <- lift $
- (,,)
- <$> io (pixelToString d px)
- <*> io (pixelToString d oPx)
- <*> io (pixelToString d fPx)
+ (px, oPx, fPx) <-
+ lift $
+ (,,)
+ <$> stringToPixel d color
+ <*> (stringToPixel d =<< asks (normalBorderColor . config))
+ <*> (stringToPixel d =<< asks (focusedBorderColor . config))
+
+ (colorName, oColorName, fColorName) <-
+ lift $
+ (,,)
+ <$> io (pixelToString d px)
+ <*> io (pixelToString d oPx)
+ <*> io (pixelToString d fPx)
forM_ wins $ \w ->
lift $ setWindowBorderWithFallback d w colorName px
@@ -164,7 +166,7 @@ withBorderColorM s ws fn = toMaybeT $ withBorderColorE s ws (toExceptT fn)
withBorderColor :: String -> [Window] -> X a -> X a
withBorderColor s ws fn =
- either absurd id <$> runExceptT (withBorderColorE s ws (lift fn))
+ either absurd id <$> runExceptT (withBorderColorE s ws (lift fn))
withBorderWidth :: Int -> [Window] -> X a -> X a
withBorderWidth width ws fn = do