1 files changed, 137 insertions, 0 deletions
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
new file mode 100644
index 0000000..e0b78c5
--- /dev/null
+++ b/src/Internal/Lib.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE RankNTypes #-}
+module Internal.Lib where
+
+import Prelude hiding ((!!))
+
+import XMonad.Prompt
+import XMonad.Prompt.Input
+import XMonad.Prompt.Shell
+
+import Internal.PromptConfig
+
+import Data.Char
+import Data.List hiding ((!!))
+import Data.List.Safe ((!!))
+import Data.Maybe
+import Internal.Marking
+import Internal.XPlus
+import Text.Printf
+import XMonad hiding (workspaces, Screen)
+import XMonad.StackSet hiding (filter, focus)
+import qualified Data.Map as Map
+
+type WorkspaceName = Char
+newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
+
+data WinPrompt = WinPrompt
+
+instance XPrompt WinPrompt where
+    showXPrompt _ = "[Window] "
+    commandToComplete _ = id
+
+getHorizontallyOrderedScreens ::
+  StackSet wid l a ScreenId ScreenDetail ->
+    [Screen wid l a ScreenId ScreenDetail]
+-- ^ Returns a list of screens ordered from leftmost to rightmost.
+getHorizontallyOrderedScreens windowSet =
+    flip sortBy screens $ \sc1 sc2 ->
+      let (SD (Rectangle x1 _ _ _)) = screenDetail sc1
+          (SD (Rectangle x2 _ _ _)) = screenDetail sc2
+          in x1 `compare` x2
+    where
+      screens = current windowSet : visible windowSet
+
+
+gotoWorkspace :: WorkspaceName -> XPlus l ()
+gotoWorkspace ch = do
+  mc <- getMarkContext
+  liftXPlus $ do
+    saveLastMark mc
+    windows $ greedyView $ return ch
+
+shiftToWorkspace :: WorkspaceName -> XPlus l ()
+shiftToWorkspace = liftXPlus . windows . shift . return
+
+swapWorkspace :: WorkspaceName -> XPlus l ()
+swapWorkspace toWorkspaceName = liftXPlus $ do
+  windows $ \ss -> do
+    let fromWorkspace = tag $ workspace $ current ss
+        toWorkspace = [toWorkspaceName] in
+      (StackSet (swapSc fromWorkspace toWorkspace $ current ss)
+                (map (swapSc fromWorkspace toWorkspace) $ visible ss)
+                (map (swapWs fromWorkspace toWorkspace) $ hidden ss)
+                (floating ss))
+  where
+    swapSc fromWorkspace toWorkspace (Screen ws a b) =
+        Screen (swapWs fromWorkspace toWorkspace ws) a b
+
+    swapWs fromWorkspace toWorkspace ws@(Workspace t' l s)
+        | t' == fromWorkspace = Workspace toWorkspace l s
+        | t' == toWorkspace = Workspace fromWorkspace l s
+        | otherwise = ws
+
+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
+
+relativeWorkspaceShift :: Selector -> X ()
+relativeWorkspaceShift (Selector selector) = do
+  windows $ \ss ->
+    let tags = sort $ (tag <$> filter (isJust . stack) (workspaces ss))
+        from = tag $ workspace $ current ss
+        to = selector from tags
+    in greedyView to ss
+
+next :: Selector
+next = Selector $ \a l -> select a l l
+  where select n (x:y:xs) _ | n == x = y 
+        select n [x] (y:_) | n == x = y
+        select n (x:xs) orig = select n xs orig
+        select n _ _ = n
+
+prev :: Selector
+prev = Selector $ \a l ->
+  let (Selector fn) = next in fn a (reverse l)
+
+withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> XPlus l ()
+withScreen fn n = do
+  markContext <- getMarkContext
+
+  liftXPlus $
+    windows $ \windowSet ->
+      case (getHorizontallyOrderedScreens windowSet !! n) of
+        Nothing -> windowSet
+        Just screen -> fn (tag $ workspace screen) windowSet
+
+windowJump :: XPlus l ()
+windowJump = do
+  markContext <- getMarkContext
+
+  liftXPlus $ do
+    windowTitlesToWinId <- withWindowSet $ \ss ->
+      Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
+
+    mkXPrompt
+      WinPrompt
+      xpConfig
+      (\input -> return $ filter (fuzzyCompletion input) (Map.keys windowTitlesToWinId)) $
+      \str -> do
+        saveLastMark markContext
+        case Map.lookup str windowTitlesToWinId of
+          Just w -> focus w
+          Nothing ->
+            case filter (fuzzyCompletion str) (Map.keys windowTitlesToWinId) of
+              [s] -> mapM_ focus (Map.lookup s windowTitlesToWinId)
+              _ -> return ()