From 3a26f3eb4f02052fdb97dcdd884f408d52b383a9 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 17 Apr 2022 23:15:55 -0600
Subject: Starting to implement window management language

---
 src/Rahm/Desktop/Common.hs | 86 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 86 insertions(+)
 create mode 100644 src/Rahm/Desktop/Common.hs

(limited to 'src/Rahm/Desktop/Common.hs')

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
new file mode 100644
index 0000000..926d5ff
--- /dev/null
+++ b/src/Rahm/Desktop/Common.hs
@@ -0,0 +1,86 @@
+module Rahm.Desktop.Common where
+
+import Prelude hiding ((!!))
+
+import Control.Monad.Trans.Maybe
+import XMonad.Actions.DynamicWorkspaces
+import XMonad.Util.Run
+import XMonad.Prompt
+import XMonad.Prompt.Input
+import XMonad.Prompt.Shell
+
+import Rahm.Desktop.PromptConfig
+
+import Data.Char
+import Data.List hiding ((!!))
+import Data.List.Safe ((!!))
+import Data.Maybe
+import Text.Printf
+import XMonad hiding (workspaces, Screen)
+import XMonad.StackSet hiding (filter, focus)
+import qualified Data.Map as Map
+import Rahm.Desktop.DMenu
+import Data.Ord (comparing)
+
+import qualified XMonad.StackSet as S
+import Rahm.Desktop.Windows
+
+-- A location is a workspace and maybe a window with that workspace.
+data Location = Location {
+    locationWorkspace :: WorkspaceId,
+    locationWindow :: Maybe Window
+  } deriving (Read, Show, Eq, Ord)
+
+focusLocation :: Location -> X ()
+focusLocation (Location ws Nothing) = windows $ S.greedyView ws
+focusLocation (Location _ (Just win)) = windows $ S.focusWindow win
+
+masterWindow :: MaybeT X Window
+masterWindow = MaybeT $ withWindowSet $ \ss ->
+  let windows = (S.integrate' . S.stack . S.workspace . S.current) ss
+    in case windows of
+      (a:_) -> return $ Just a
+      _ -> return Nothing
+
+data WinPrompt = WinPrompt
+
+instance XPrompt WinPrompt where
+    showXPrompt _ = "[Window] "
+    commandToComplete _ = id
+
+fuzzyCompletion :: String -> String -> Bool
+fuzzyCompletion str0 str1 =
+  all (`isInfixOf`l0) ws
+  where
+    ws = filter (not . all isSpace) $ words (map toLower str0)
+    l0 = map toLower str1
+
+getString :: Window -> X String
+getString = runQuery $ do
+  t <- title
+  a <- appName
+  return $
+    if map toLower a `isInfixOf` map toLower t
+      then t
+      else printf "%s - %s" t a
+
+askWindowId :: X (Maybe Window)
+askWindowId = do
+  windowTitlesToWinId <- withWindowSet $ \ss ->
+    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
+
+  runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+
+windowJump :: X ()
+windowJump = mapM_ focus =<< askWindowId
+
+gotoWorkspace :: WorkspaceId -> X ()
+gotoWorkspace wid = do
+  addHiddenWorkspace wid
+  windows $ S.greedyView wid
+
+getCurrentWorkspace :: X WorkspaceId
+getCurrentWorkspace = withWindowSet $
+  \(S.StackSet (S.Screen (S.Workspace t _ _) _ _) _ _ _) -> do
+    return t
+
-- 
cgit