From 6d3c8bc19f8ccf6e1a114b8fb3bd1cdf35eddc16 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 15 Mar 2020 15:50:07 -0400 Subject: [PATCH] REF removed unused build file and move xmonad.hs to bin --- bin/xmonad.hs | 630 ++++++++++++++++++++++++++++++++++++++++++++++++ build | 12 - my-xmonad.cabal | 3 +- 3 files changed, 631 insertions(+), 14 deletions(-) create mode 100644 bin/xmonad.hs delete mode 100755 build diff --git a/bin/xmonad.hs b/bin/xmonad.hs new file mode 100644 index 0000000..d1b25ec --- /dev/null +++ b/bin/xmonad.hs @@ -0,0 +1,630 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} + +module Main (main) where + +import ACPI +import SendXMsg + +import Control.Monad (mapM_, forM_, void, when) + +import Data.List (sortBy, sortOn) +import Data.Maybe (fromMaybe, isJust) +import Data.Monoid (All(..)) + +import Graphics.X11.Xlib.Atom +import Graphics.X11.Xlib.Extras +import Graphics.X11.Types + +import Control.Exception + +import System.Exit +import System.IO +import System.Process (waitForProcess) +import System.Process.Internals + ( ProcessHandle__(ClosedHandle, OpenHandle) + , withProcessHandle + , mkProcessHandle) +import System.Posix.IO +import System.Posix.Process +import System.Posix.Signals +import System.Posix.Types + +import Text.Read (readMaybe) + +import XMonad +import XMonad.Actions.CopyWindow +import XMonad.Actions.CycleWS +import XMonad.Actions.DynamicWorkspaces +import XMonad.Actions.PhysicalScreens +import XMonad.Actions.Volume +-- import XMonad.Config.Desktop +import XMonad.Hooks.DynamicLog +import XMonad.Hooks.EwmhDesktops +import XMonad.Hooks.ManageDocks +-- import XMonad.Layout.IndependentScreens +import XMonad.Hooks.ManageHelpers +-- import XMonad.Layout.BinarySpacePartition (emptyBSP) +-- import XMonad.Layout.DragPane +-- import XMonad.Layout.IM +-- import XMonad.Layout.LayoutCombinators hiding ((|||)) +import XMonad.Layout.Named +import XMonad.Layout.NoBorders +import XMonad.Layout.NoFrillsDecoration +import XMonad.Layout.PerWorkspace +-- import XMonad.Layout.ResizableTile +import XMonad.Layout.Tabbed +-- import XMonad.Layout.ToggleLayouts (ToggleLayout(..), toggleLayouts) +import XMonad.Prompt +import XMonad.Prompt.ConfirmPrompt +-- import XMonad.Prompt.XMonad +-- import XMonad.Prompt.Shell +import XMonad.Util.EZConfig +import XMonad.Util.NamedActions +import XMonad.Util.Run +-- import XMonad.Util.WindowProperties + +import qualified XMonad.StackSet as W + +main = do + (barPID, h) <- spawnPipe' "xmobar" + pwrPID <- spawnPID "powermon" + launch + $ ewmh + $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID]) + $ def { terminal = myTerm + , modMask = myModMask + , layoutHook = myLayouts + , manageHook = myManageHook <+> manageDocks <+> manageHook def + , handleEventHook = myEventHook <+> docksEventHook <+> handleEventHook def + , startupHook = docksStartupHook <+> startupHook def + , workspaces = myWorkspaces + , logHook = myLoghook h + , clickJustFocuses = False + , focusFollowsMouse = False + } + +spawnPipe' :: MonadIO m => String -> m (ProcessID, Handle) +spawnPipe' x = io $ do + (rd, wr) <- createPipe + setFdOption wr CloseOnExec True + h <- fdToHandle wr + hSetBuffering h LineBuffering + p <- xfork $ do + _ <- dupTo rd stdInput + executeFile "/bin/sh" False ["-c", x] Nothing + closeFd rd + return (p, h) + +myTopBarTheme = def + { fontName = myFont + , inactiveBorderColor = "#999999" + , inactiveColor = "#999999" + , inactiveTextColor = "#999999" + , activeBorderColor = "#d6d6d6" + , activeColor = "#d6d6d6" + , activeTextColor = "#d6d6d6" + -- , urgentBorderColor = red + -- , urgentTextColor = yellow + , decoHeight = 20 + } + +myTabbedTheme = def + { fontName = myFont + , activeColor = "#d6d6d6" + , activeTextColor = "black" + , activeBorderColor = "#d6d6d6" + , inactiveColor = "#999999" + , inactiveTextColor = "#333333" + , inactiveBorderColor = "#999999" + } + +myWorkspaces = map show [1..10 :: Int] + +myVMWorkspace = "VM" +myGimpWorkspace = "GIMP" + +myLayouts = onWorkspace myVMWorkspace (noBorders Full) + -- $ onWorkspace myGimpWorkspace gimpLayout + $ tall ||| single ||| full + where + addTopBar = noFrillsDeco shrinkText myTopBarTheme + tall = named "Tall" + $ avoidStruts + $ addTopBar + $ noBorders + $ Tall 1 0.03 0.5 + single = named "Tabbed" + -- $ addTopBar + $ avoidStruts + $ noBorders + $ tabbedAlways shrinkText myTabbedTheme + full = named "Full" + $ noBorders Full + -- gimpLayout = named "Gimp Layout" + -- $ avoidStruts + -- $ (tabbedAlways shrinkText defaultTheme) ****||* Full + -- -- $ withIM (11/64) (Or (Title "Toolbox") (Title "Tool Options")) + -- -- $ (tabbedAlways shrinkText defaultTheme) + +-- | Format workspace and layout in loghook +-- The format will be like "[<1> 2 3] 4 5 | LAYOUT" where each digit +-- is the workspace and LAYOUT is the current layout. Each workspace +-- in the brackets is currently visible and the order reflects the +-- physical location of each screen. The "<>" is the workspace +-- that currently has focus +myLoghook h = withWindowSet $ io . hPutStrLn h . myWindowSetXinerama + +myWindowSetXinerama ws = wsString ++ sep ++ layout + where + wsString = xmobarColor "#444444" "" $ onscreen ++ offscreen' + offscreen' = if offscreen == "" then "" else " " ++ offscreen + sep = xmobarColor "#888888" "" " : " + onscreen = xmobarColor "#5574ad" visColor + $ wrap " " " " + $ unwords + $ map (fmtTags . W.tag . W.workspace) + . sortBy compareXCoord + $ W.current ws : W.visible ws + fmtTags t = if t == W.currentTag ws + then xmobarColor "#2c2c2c" visColor t + else t + offscreen = unwords + $ map W.tag + . filter (isJust . W.stack) + . sortOn W.tag + $ W.hidden ws + visColor = "#8fc7ff" + layout = description . W.layout . W.workspace . W.current $ ws + compareXCoord s0 s1 = compare x0 x1 + where + (_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0 + (_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1 + +myManageHook = composeOne + -- assume virtualbox is not run with the toolbar in fullscreen mode + -- as this makes a new window that confusingly must go over the + -- actual VM window + [ className =? "VirtualBoxVM" -?> doShift "VM" + -- the seafile applet + , className =? "Seafile Client" -?> doFloat + -- gnucash + , (className =? "Gnucash" <&&> title =? "Transaction Import Assistant") -?> doFloat + -- xsane + , className =? "Xsane" -?> doFloat + -- all of GIMP + , className =? "Gimp" -?> doFloat + -- , title =? "GIMP Startup" -?> doIgnore + -- plots and graphics created by R + , className =? "R_x11" -?> doFloat + , className =? "mpv" -?> doFloat + -- the floating windows created by the brave browser + , stringProperty "WM_NAME" =? "Brave" -?> doFloat + , (stringProperty "WM_WINDOW_ROLE" =? "pop-up" + <&&> className =? "Brave-browser") -?> doFloat + -- the dialog windows created by the zotero addon in Google Docs + , (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat + , isDialog -?> doCenterFloat + ] + +-- This is a giant hack to "listen" for applications that close. Some +-- apps like Virtualbox go on their own workspace which is dynamically +-- created. But I want said workspace to disappear when the app +-- closes. This is actually hard. We can't just listen to +-- DestroyWindow events as VBox will "destroy" windows when it +-- switches to fullscreen and back. We also can't just monitor the +-- process from the window since WindowDestroy events don't have PIDs +-- attached to them. Therefore, the hack to make this all work is to +-- make a script fire when VirtualBox (and other apps that I want to +-- control in this manner) close. This script fires a bogus +-- ClientMessage event to the root window. This event will have a +-- BITMAP atom (which should do nothing) and a "magic string" in the +-- data field that can be intercepted here. When this event is +-- registered here, close the dynamic workspaces that are empty. +myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } + | t == bITMAP = do + let (magic, tag) = splitXMsg d + if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag + | magic == acpiMagic -> do + let acpiTag = readMaybe tag :: Maybe ACPIEvent + forM_ acpiTag $ \case + Power -> myPowerPrompt + Sleep -> confirmPrompt myPromptTheme "suspend?" runSuspend + LidClose -> do + status <- io isDischarging + forM_ status $ \s -> runScreenLock >> when s runSuspend + | otherwise -> return () + return (All True) + | otherwise = return (All True) +myEventHook _ = return (All True) + +removeEmptyWorkspaceByTag' tag = do + -- TODO this function works by first hiding the workspace to be + -- removed and then removing it. This won't work if there are no + -- other hidden workspaces to take it's place. So, need to scan + -- through the list of workspaces and swap the first one that is + -- empty with the workspace to be removed. If it actually is empty, + -- this will be enough to make it disappear. + removeEmptyWorkspaceByTag tag + +-- themes +myFont = "xft:DejaVu Sans:size=11:autohint=false" + +-- base00 = "#657b83" +-- base01 = "#586e75" +-- base02 = "#073642" +-- base03 = "#002b36" +-- base0 = "#839496" +-- base1 = "#93a1a1" +-- base2 = "#eee8d5" +-- base3 = "#fdf6e3" +-- yellow = "#b58900" +-- orange = "#cb4b16" +-- red = "#dc322f" +-- magenta = "#d33682" +-- violet = "#6c71c4" +-- blue = "#268bd2" +-- cyan = "#2aa198" +-- green = "#859900" + +-- gap = 10 +-- topbar = 10 +-- border = 0 +-- prompt = 20 +-- status = 20 + +-- active = blue +-- activeWarn = red +-- inactive = base02 +-- focusColor = blue +-- unfocusColor = base02 + +myPromptTheme = def + { font = myFont + , bgColor = "#eeeeee" + , fgColor = "#282828" + , fgHLight = "white" + , bgHLight = "#268bd2" + , borderColor = "white" + , promptBorderWidth = 0 + , height = 30 + , position = CenteredAt 0.5 0.5 +} + +-- hotPromptTheme = myPromptTheme +-- { bgColor = red +-- , fgColor = base3 +-- , position = Top +-- } + + +-- TODO is there a better way to get the prompt to say what I want? +data PowerPrompt = PowerPrompt + +instance XPrompt PowerPrompt where + showXPrompt PowerPrompt = "Select Option: " + +runScreenLock :: X () +runScreenLock = spawn "screenlock" + +runPowerOff :: X () +runPowerOff = spawn "systemctl poweroff" + +runSuspend :: X () +runSuspend = spawn "systemctl suspend" + +runHibernate :: X () +runHibernate = spawn "systemctl hibernate" + +runReboot :: X () +runReboot = spawn "systemctl reboot" + +myPowerPrompt :: X () +myPowerPrompt = mkXPrompt PowerPrompt conf comps + $ fromMaybe (return ()) + . (`lookup` commands) + where + comps = mkComplFunFromList' (map fst commands) + conf = myPromptTheme + commands = + [ ("poweroff", runPowerOff) + , ("suspend", runScreenLock >> runSuspend) + , ("hibernate", runScreenLock >> runHibernate) + , ("reboot", runReboot) + ] + +myQuitPrompt :: X () +myQuitPrompt = confirmPrompt myPromptTheme "quit?" $ io exitSuccess + +-- shell commands + +formatCmd :: String -> [String] -> String +formatCmd cmd args = unwords $ cmd : args + +spawnCmd :: String -> [String] -> X () +spawnCmd cmd args = spawn $ formatCmd cmd args + +(#!&&) :: String -> String -> String +cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB + +infixr 0 #!&& + +(#!||) :: String -> String -> String +cmdA #!|| cmdB = cmdA ++ " || " ++ cmdB + +infixr 0 #!|| + +magicStringWS :: String +magicStringWS = "%%%%%" + +spawnCmdOwnWS :: String -> [String] -> String -> X () +spawnCmdOwnWS cmd args ws = spawn + $ formatCmd cmd args + #!&& formatCmd "xit-event" [magicStringWS, ws] + +-- spawnKill :: [String] -> X () +-- spawnKill = mapM_ (spawn . ("killall " ++)) + +myTerm :: String +myTerm = "urxvt" + +runTerm :: X () +runTerm = spawn myTerm + +runCalc :: X () +runCalc = spawnCmd myTerm ["-e", "R"] + +myDmenuCmd :: String +myDmenuCmd = "rofi" + +-- TODO this almost works except when a workspace with no windows is +-- focuses. In this case, rofi considers the root window to be focused +-- and will showup wherever the mouse pointer is. Need a way to get +-- the focused workspace and translate that to a monitor number for +-- rofi to consume +myDmenuArgs :: [String] +myDmenuArgs = ["-m", "-4"] -- show rofi with the focused window + +spawnDmenuCmd :: [String] -> X () +spawnDmenuCmd args = spawnCmd myDmenuCmd $ myDmenuArgs ++ args + +runCmdMenu :: X () +runCmdMenu = spawnDmenuCmd ["-show", "run"] + +runAppMenu :: X () +runAppMenu = spawnDmenuCmd ["-show", "drun"] + +runClipMenu :: X () +runClipMenu = spawnDmenuCmd + [ "-modi", "\"clipboard:greenclip print\"" + , "-show", "clipboard" + , "-run-command", "'{cmd}'" + , "-theme-str", "'#element.selected.normal { background-color: #00c44e; }'" + ] + +runWinMenu :: X () +runWinMenu = spawnDmenuCmd ["-show", "window"] + +runNetMenu :: X () +runNetMenu = spawnCmd "networkmanager_dmenu" myDmenuArgs + +runDevMenu :: X () +runDevMenu = spawn "rofi-devices" + +runBrowser :: X () +runBrowser = spawn "brave" + +runEditor :: X () +runEditor = spawnCmd "emacsclient" + ["-c", "-e", "\"(select-frame-set-input-focus (selected-frame))\""] + +runFileManager :: X () +runFileManager = spawn "pcmanfm" + +-- TODO this will steal focus from the current window (and puts it +-- in the root window?) ...need to fix +runScreenCap :: X () +runScreenCap = spawn "flameshot gui" +-- myWindowCap = "screencap -w" --external script + +runVBox :: X () +runVBox = spawnCmdOwnWS "vbox-start win8raw" [] myVMWorkspace + +runGimp :: X () +runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace + +runCleanup :: [ProcessID] -> X () +runCleanup ps = io $ mapM_ killPID ps + +killPID :: ProcessID -> IO () +killPID pID = do + h <- mkProcessHandle pID False + -- this may fail of the PID does not exist + _ <- try $ sendSIGTERM h :: IO (Either IOException ()) + -- this may fail if the process exits instantly and the handle + -- is destroyed by the time we get to this line (I think?) + _ <- try $ waitForProcess h :: IO (Either IOException ExitCode) + return () + where + sendSIGTERM h = withProcessHandle h $ \case + OpenHandle _ -> signalProcess sigTERM pID + ClosedHandle _ -> return () + _ -> return () -- this should never happen + +runRestart :: X () +runRestart = restart "xmonad" True + +runRecompile :: X () +runRecompile = do + -- assume that the conf directory contains a valid stack project + -- TODO this is hacky AF + confDir <- getXMonadDir + spawn $ cmd confDir + where + cmd c = formatCmd "cd" [c] + #!&& formatCmd "stack" ["install", ":xmonad"] + #!&& formatCmd "notify-send" ["\"compilation succeeded\""] + #!|| formatCmd "notify-send" ["\"compilation failed\""] + +myMultimediaCtl :: String +myMultimediaCtl = "playerctl" + +runTogglePlay :: X () +runTogglePlay = spawnCmd myMultimediaCtl ["play-pause"] + +runPrevTrack :: X () +runPrevTrack = spawnCmd myMultimediaCtl ["previous"] + +runNextTrack :: X () +runNextTrack = spawnCmd myMultimediaCtl ["next"] + +runStopPlay :: X () +runStopPlay = spawnCmd myMultimediaCtl ["stop"] + +runVolumeDown :: X () +runVolumeDown = void (lowerVolume 2) + +runVolumeUp :: X () +runVolumeUp = void (raiseVolume 2) + +runVolumeMute :: X () +runVolumeMute = void toggleMute + +runToggleBluetooth :: X () +runToggleBluetooth = spawn "togglebt" + +runIncBacklight :: X () +runIncBacklight = spawnCmd "adj_backlight" ["up"] + +runDecBacklight :: X () +runDecBacklight = spawnCmd "adj_backlight" ["down"] + +runMinBacklight :: X () +runMinBacklight = spawnCmd "adj_backlight" ["min"] + +runMaxBacklight :: X () +runMaxBacklight = spawnCmd "adj_backlight" ["max"] + +showWorkspace tag = windows $ W.view tag + +enableDPMS :: X () +enableDPMS = spawnCmd "xset" ["s", "on", "+dpms"] + +disableDPMS :: X () +disableDPMS = spawnCmd "xset" ["s", "off", "-dpms"] + +-- keybindings + +showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction +showKeybindings x = addName "Show Keybindings" $ io $ do + h <- spawnPipe cmd + hPutStr h (unlines $ showKm x) + hClose h + return () + where cmd = formatCmd myDmenuCmd $ myDmenuArgs ++ + [ "-dmenu" + , "-p" + , "commands" + , "-theme-str" + , "'#element.selected.normal { background-color: #a200ff; }'" + ] + +myModMask :: KeyMask +myModMask = mod4Mask + +mkNamedSubmap + :: XConfig l + -> String + -> [(String, NamedAction)] + -> [((KeyMask, KeySym), NamedAction)] +mkNamedSubmap c sectionName bindings = + (subtitle sectionName:) $ mkNamedKeymap c bindings + +-- NOTE: the following bindings are used by dunst: +-- "M-~", "M-", "M-S-", "M-S-." +myKeys :: [ProcessID] -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)] +myKeys hs c = + mkNamedSubmap c "Window Layouts" + [ ("M-j", addName "focus down" $ windows W.focusDown) + , ("M-k", addName "focus up" $ windows W.focusUp) + , ("M-m", addName "focus master" $ windows W.focusMaster) + , ("M-S-j", addName "swap down" $ windows W.swapDown) + , ("M-S-k", addName "swap up" $ windows W.swapUp) + , ("M-S-m", addName "swap master" $ windows W.swapMaster) + -- TODO this will decrement past 0? + , ("M-C-j", addName "remove master window" $ sendMessage (IncMasterN (-1))) + , ("M-C-k", addName "add master window" $ sendMessage (IncMasterN 1)) + , ("M-", addName "next layout" $ sendMessage NextLayout) + , ("M-S-", addName "reset layout" $ setLayout $ XMonad.layoutHook c) + , ("M-t", addName "sink tiling" $ withFocused $ windows . W.sink) + , ("M--", addName "shrink" $ sendMessage Shrink) + , ("M-=", addName "expand" $ sendMessage Expand) + ] ++ + + mkNamedSubmap c "Workspaces" + -- NOTE this assumes that there are workspaces bound to numbers + ([ (mods ++ show i, addName (msg ++ " " ++ show i) $ windows $ f w) + | (w, i) <- zip (XMonad.workspaces c) [1..] :: [(String, Int)] + , (mods, msg, f) <- + [ ("M-", "switch to workspace", W.view) + , ("M-S-", "move client to workspace", W.shift)] + ] ++ + [ ("M-v", addName "switch to VM workspace" $ showWorkspace myVMWorkspace) + , ("M-M1-g", addName "switch to Gimp workspace" $ showWorkspace myGimpWorkspace) + ]) ++ + + mkNamedSubmap c "Screens" + [ ("M-l", addName "move up screen" nextScreen) + , ("M-h", addName "move down screen" prevScreen) + , ("M-C-l", addName "move client up screen" $ shiftNextScreen >> nextScreen) + , ("M-C-h", addName "move client down screen" $ shiftPrevScreen >> prevScreen) + , ("M-S-l", addName "shift up screen" $ swapNextScreen >> nextScreen) + , ("M-S-h", addName "shift down screen" $ swapPrevScreen >> prevScreen) + ] ++ + + mkNamedSubmap c "Actions" + [ ("M-q", addName "close window" kill1) + , ("M-r", addName "run program" runCmdMenu) + , ("M-C-s", addName "capture screen area" runScreenCap) + -- , ("M-C-S-s", addName "capture focused window" $ spawn myWindowCap) + , ("M-", addName "lock screen" runScreenLock) + ] ++ + + mkNamedSubmap c "Launchers" + [ ("", addName "select/launch app" runAppMenu) + , ("M-g", addName "launch clipboard manager" runClipMenu) + , ("M-a", addName "launch network selector" runNetMenu) + , ("M-w", addName "launch window selector" runWinMenu) + , ("M-u", addName "launch device selector" runDevMenu) + , ("M-C-e", addName "launch editor" runEditor) + , ("M-C-w", addName "launch browser" runBrowser) + , ("M-C-t", addName "launch terminal" runTerm) + , ("M-C-q", addName "launch calc" runCalc) + , ("M-C-f", addName "launch file manager" runFileManager) + , ("M-C-v", addName "launch windows VM" $ runVBox >> appendWorkspace myVMWorkspace) + , ("M-C-g", addName "launch GIMP" $ runGimp >> appendWorkspace myGimpWorkspace) + ] ++ + + mkNamedSubmap c "Multimedia" + [ ("", addName "toggle play/pause" runTogglePlay) + , ("", addName "previous track" runPrevTrack) + , ("", addName "next track" runNextTrack) + , ("", addName "stop" runStopPlay) + , ("", addName "volume down" runVolumeDown) + , ("", addName "volume up" runVolumeUp) + , ("", addName "volume mute" runVolumeMute) + , ("M-C-b", addName "toggle bluetooth" runToggleBluetooth) + ] ++ + + mkNamedSubmap c "System" + [ ("M-.", addName "backlight up" runIncBacklight) + , ("M-,", addName "backlight down" runDecBacklight) + , ("M-M1-,", addName "backlight min" runMinBacklight) + , ("M-M1-.", addName "backlight max" runMaxBacklight) + , ("M-M1-=", addName "enable screensaver" enableDPMS) + , ("M-M1--", addName "disable screensaver" disableDPMS) + , ("M-", addName "restart xmonad" $ runCleanup hs >> runRestart) + , ("M-S-", addName "recompile xmonad" runRecompile) + , ("M-", addName "power menu" myPowerPrompt) + , ("M-", addName "quit xmonad" myQuitPrompt) + ] diff --git a/build b/build deleted file mode 100755 index be9b6aa..0000000 --- a/build +++ /dev/null @@ -1,12 +0,0 @@ -#!/bin/sh -# -# As of 0.13, xmonad --recompile will look for a custom build script. - -exec stack ghc -- \ - --make xmonad.hs \ - -i \ - -ilib \ - -fforce-recomp \ - -main-is main \ - -v0 \ - -o "$1" diff --git a/my-xmonad.cabal b/my-xmonad.cabal index 0b584d9..acc3caa 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -15,7 +15,7 @@ library default-language: Haskell2010 executable xmonad - main-is: ../xmonad.hs + main-is: bin/xmonad.hs build-depends: base , xmonad >= 0.13 , xmonad-contrib >= 0.13 @@ -24,7 +24,6 @@ executable xmonad , unix >= 2.7.2.2 , process >= 1.6.5.0 , my-xmonad - hs-source-dirs: bin default-language: Haskell2010 ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded