diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,3 +1,135 @@ -import XMonad.Config.Vanessa +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -main = vConfig +-- | Configuration with defaults I like. +module Main (main) where + +import qualified Data.Map as M +import Data.Maybe +import Data.Monoid +import Data.Ratio ((%)) +import System.IO (Handle) +import XMonad hiding (workspaces) +import XMonad.Actions.GridSelect +import XMonad.Hooks.DynamicLog +import XMonad.Hooks.ManageDocks +import XMonad.Layout.Hidden +import XMonad.Layout.Mosaic +import XMonad.Layout.Reflect +import XMonad.Layout.Spiral +import XMonad.StackSet hiding (float) +import XMonad.Util.Keyboard +import XMonad.Util.MediaKeys +import XMonad.Util.NamedWindows +import XMonad.Util.Run +import XMonad.Util.Volume + +-- TODO wallpaper? + +-- | IO action of the whole thing +main :: IO () +main = xmonad . config' =<< spawnPipe "xmobar" + where config' = myConfig + +-- | Custom configuration taking in one pipe to xmobar +myConfig xmproc = docks $ def { terminal = "alacritty" + , keys = newKeys + , layoutHook = myLayout + , logHook = vLogHook xmproc + , manageHook = myManageHook <+> manageDocks + , handleEventHook = docksEventHook + , startupHook = docksStartupHook + } + +-- | get the current music playing (assumed to be in number 5) +musicString :: X String +musicString = do + winset <- gets windowset + wt <- maybe (pure "") (fmap show . getName) . fmap snd . listToMaybe $ zip ((fmap tag . workspaces) winset) (allWindows winset) + pure . xmobarColor "green" "black" . take 40 $ wt + +-- | Provides custom hooks to xmonad. This disables printing the window title/connects xmobar and xmonad. +vLogHook :: Handle -> X () +vLogHook xmproc = musicString >>= \m -> dynamicLogWithPP xmobarPP { ppOutput = hPutStrLn xmproc + , ppTitle = const m + , ppLayout = const "" + , ppHiddenNoWindows = id + , ppHidden = xmobarColor "darkorange" "black" + , ppVisible = xmobarColor "yellow" "black" + } + +-- | Doesn't work on spotify +myManageHook :: Query (Endo WindowSet) +myManageHook = composeAll (shifts : floats) + + where shifts = className =? "Firefox" --> doF (shift "5") + + floats = fmap (--> doFloat) (classes <> resources) + resources = fmap (resource =?) resourceNames + classes = fmap (className =?) classNames + resourceNames = [ "launcher", "qemu-system-arm" ] + classNames = [ "Gimp-2.8", "libreoffice-write", "Gimp", "keepassx", "xviewer", "qemu-system-x86_64" ] + +mkSmall :: Window -> X () +mkSmall = flip tileWindow (Rectangle 850 150 600 400) + +-- | Custom keymaps to adjust volume, brightness, and +myKeys :: XConfig t -> M.Map (KeyMask, KeySym) (X ()) +myKeys XConfig { XMonad.modMask = modm } = mediaKeys . M.fromList $ + [ --volume control + ((modm, xK_Up), raiseVolume (5 :: Word)) + , ((modm, xK_Down), lowerVolume (5 :: Word)) + , ((modm, xK_BackSpace), toggleMute) + --personal (extra) media keys + , ((modm, xK_Page_Down), audioNext) + , ((modm, xK_Page_Up), audioPrev) + , ((modm, xK_Home), audioPlayPause) + , ((modm, xK_Return), audioPlayPause) + --program shortcuts + , ((modm, xK_q), spawn "spotify") + , ((modm .|. shiftMask, xK_t), spawn "thunderbird") + , ((modm .|. shiftMask, xK_n), spawn "firefox") + , ((modm .|. controlMask, xK_Return), spawn "gnome-terminal") + --launch bar + , ((modm, xK_p), spawn "$(yeganesh -x)") + --screenshots + , ((0, xK_Print), spawn "cd ~/.screenshots && scrot") + -- open scratchpad + , ((modm .|. shiftMask, xK_p), withFocused (mconcat . sequence [float, mkSmall])) + -- TODO: keybindings to move all windows in a workspace to another + -- workspace? + --shutdown etc. + , ((modm .|. shiftMask, xK_End), spawn "shutdown now") + -- lock screen + , ((controlMask, xK_End), spawn "slock") + --switch keyboards + , ((modm, xK_F1), setLang def) + , ((modm, xK_F2), setLang tibetan) + , ((modm, xK_F3), setLang accented) + , ((modm, xK_F4), setLang français) + , ((modm, xK_F5), setLang deutsch) + , ((modm, xK_F6), setLang dansk) + , ((modm, xK_F7), setLang dzongkha) + -- hide windows + , ((modm .|. shiftMask, xK_h), withFocused (mconcat . sequence [hide, hideWindow])) + , ((modm, xK_u), popNewestHiddenWindow >> withFocused reveal) + -- grid select + , ((modm, xK_g), goToSelected def) + -- Mosaic adjustment + , ((modm, xK_a), sendMessage Taller) + , ((modm, xK_s), sendMessage Wider) + , ((modm, xK_r), sendMessage Reset) + ] + +-- | Function giving keybindings to undo +keysToRemove :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +keysToRemove XConfig { XMonad.modMask = modm } = M.fromList + [ ((modm, xK_p), pure ()) ] + +-- | Gives a better ratio for the master pane and lets us spiral windows +myLayout = (avoidStruts . hiddenWindows $ mosaic 1.33 mosaicSettings ||| normalPanes ||| reflectHoriz normalPanes ||| Full) ||| hiddenWindows (spiral (6/7)) + where normalPanes = Tall 1 (3/100) (3/7) + mosaicSettings = take 6 $ iterate (* (4 % 5)) 1 + +-- | Make new key layout from a given keyboard layout +newKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +newKeys x = myKeys x `M.union` (keys def x `M.difference` keysToRemove x) diff --git a/app/ParseKBLayout.hs b/app/ParseKBLayout.hs --- a/app/ParseKBLayout.hs +++ b/app/ParseKBLayout.hs @@ -1,3 +1,4 @@ import XMonad.Util.Keyboard (showKBLayout) -main = show <$> showKBLayout +main :: IO () +main = putStrLn =<< showKBLayout diff --git a/cabal.project.local b/cabal.project.local --- a/cabal.project.local +++ b/cabal.project.local @@ -1,1 +1,3 @@ optimization: 2 +allow-newer: + base diff --git a/src/XMonad/Config/Vanessa.hs b/src/XMonad/Config/Vanessa.hs deleted file mode 100644 --- a/src/XMonad/Config/Vanessa.hs +++ /dev/null @@ -1,146 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} - --- | Configuration with defaults I like. -module XMonad.Config.Vanessa (vConfig) where - -import qualified Data.Map as M -import Data.Maybe -import Data.Monoid -import Data.Ratio ((%)) -import System.IO (Handle) -import XMonad hiding (workspaces) -import XMonad.Actions.GridSelect -import XMonad.Hooks.DynamicLog -import XMonad.Hooks.ManageDocks -import XMonad.Layout.Hidden -import XMonad.Layout.Mosaic -import XMonad.Layout.Reflect -import XMonad.Layout.Spiral -import XMonad.StackSet hiding (float) -import XMonad.Util.Brightness -import XMonad.Util.Keyboard -import XMonad.Util.MediaKeys -import XMonad.Util.NamedWindows -import XMonad.Util.Run -import XMonad.Util.Volume - --- TODO wallpaper? - --- | IO action of the whole thing -vConfig :: IO () -vConfig = xmonad . config' =<< spawnPipe "xmobar" - where config' = myConfig - --- | Custom configuration taking in one pipe to xmobar -myConfig xmproc = docks $ def { terminal = "alacritty" - , keys = newKeys - , layoutHook = myLayout - , logHook = vLogHook xmproc - , manageHook = myManageHook <+> manageDocks - , handleEventHook = docksEventHook - , startupHook = docksStartupHook - } - --- | get the current music playing (assumed to be in number 5) -musicString :: X String -musicString = do - winset <- gets windowset - wt <- maybe (pure "") (fmap show . getName) . fmap snd . listToMaybe $ zip ((fmap tag . workspaces) winset) (allWindows winset) - pure . xmobarColor "green" "black" . take 40 $ wt - --- | Provides custom hooks to xmonad. This disables printing the window title/connects xmobar and xmonad. -vLogHook :: Handle -> X () -vLogHook xmproc = musicString >>= \m -> dynamicLogWithPP xmobarPP { ppOutput = hPutStrLn xmproc - , ppTitle = const m - , ppLayout = const "" - , ppHiddenNoWindows = id - , ppHidden = xmobarColor "darkorange" "black" -- . (\x -> if x == "5" then "Spotify" else x) - , ppVisible = xmobarColor "yellow" "black" - } - --- | Doesn't work on spotify -myManageHook :: Query (Endo WindowSet) -myManageHook = composeAll [ className =? "Gimp-2.8" --> doFloat - , resource =? "spotify" --> doF (shift "5") - , className =? "Firefox" --> doF (shift "5") - , className =? "google-chrome" --> doF (shift "3") - , resource =? "crx_bikioccmkafdpakkkcpdbppfkghcmihk" --> doF (shift "7") - , resource =? "crx_bgkodfmeijboinjdegggmkbkjfiagaan" --> doF (shift "7") - , resource =? "launcher" --> doFloat - , resource =? "qemu-system-arm" --> doFloat - , className =? "libreoffice-writer" --> doFloat - , className =? "Gimp" --> doFloat - , className =? "keepassx" --> doFloat - , className =? "xviewer" --> doFloat - , className =? "qemu-system-x86_64" --> doFloat - ] - --- TODO gaps between windows? - -mkSmall :: Window -> X () -mkSmall = flip tileWindow (Rectangle 850 150 600 400) - --- | Custom keymaps to adjust volume, brightness, and -myKeys :: XConfig t -> M.Map (KeyMask, KeySym) (X ()) -myKeys XConfig {XMonad.modMask = modm} = mediaKeys . M.fromList $ - [ --volume control - ((modm, xK_Up), raiseVolume (5 :: Word)) - , ((modm, xK_Down), lowerVolume (5 :: Word)) - , ((modm, xK_BackSpace), toggleMute) - --personal (extra) media keys - , ((modm, xK_Page_Down), audioNext) - , ((modm, xK_Page_Up), audioPrev) - , ((modm, xK_Home), audioPlayPause) - , ((modm, xK_Return), audioPlayPause) - --brightness - , ((modm, xK_Left), brighten (-100)) - , ((modm, xK_Right), brighten 100) - --program shortcuts - , ((modm, xK_q), spawn "spotify") - , ((modm .|. shiftMask, xK_t), spawn "thunderbird") - , ((modm .|. shiftMask, xK_n), spawn "firefox") - , ((modm .|. controlMask, xK_Return), spawn "gnome-terminal") - --launch bar - , ((modm, xK_p), spawn "$(yeganesh -x)") - --screenshots - , ((0, xK_Print), spawn "cd ~/.screenshots && scrot") - -- open scratchpad - , ((modm .|. shiftMask, xK_p), withFocused (mconcat . sequence [float, mkSmall])) - -- TODO: keybindings to move all windows in a workspace to another - -- workspace? - --shutdown etc. - , ((modm .|. shiftMask, xK_End), spawn "shutdown now") - -- lock screen - , ((controlMask, xK_End), spawn "slock") - --switch keyboards - , ((modm, xK_F1), setLang def) - , ((modm, xK_F2), setLang tibetan) - , ((modm, xK_F3), setLang accented) - , ((modm, xK_F4), setLang français) - , ((modm, xK_F5), setLang deutsch) - , ((modm, xK_F6), setLang dansk) - , ((modm, xK_F7), setLang dzongkha) - -- hide windows - , ((modm .|. shiftMask, xK_h), withFocused (mconcat . sequence [hide, hideWindow])) - , ((modm, xK_u), popNewestHiddenWindow >> withFocused reveal) - -- grid select - , ((modm, xK_g), goToSelected def) - -- Mosaic adjustment - , ((modm, xK_a), sendMessage Taller) - , ((modm, xK_s), sendMessage Wider) - , ((modm, xK_r), sendMessage Reset) - ] - --- | Function giving keybindings to undo -keysToRemove :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -keysToRemove XConfig { XMonad.modMask = modm } = M.fromList - [ ((modm, xK_p), pure ()) ] - --- | Gives a better ratio for the master pane and lets us spiral windows -myLayout = (avoidStruts . hiddenWindows $ mosaic 1.33 mosaicSettings ||| normalPanes ||| reflectHoriz normalPanes ||| Full) ||| hiddenWindows (spiral (6/7)) - where normalPanes = Tall 1 (3/100) (3/7) - mosaicSettings = take 6 $ iterate (* (4 % 5)) 1 - --- | Make new key layout from a given keyboard layout -newKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -newKeys x = myKeys x `M.union` (keys def x `M.difference` keysToRemove x) diff --git a/src/XMonad/Util/Brightness.hs b/src/XMonad/Util/Brightness.hs deleted file mode 100644 --- a/src/XMonad/Util/Brightness.hs +++ /dev/null @@ -1,17 +0,0 @@ --- | Module to control screen brightness within the `X` Monad. -module XMonad.Util.Brightness (brighten) where - -import XMonad - --- | Brighten screen --- also consider splitting off once this has been generalized -brighten :: Int -> X () -brighten n = liftIO $ do - currentBacklight <- readFile "/sys/class/backlight/intel_backlight/brightness" - length currentBacklight `seq` writeFile "/sys/class/backlight/intel_backlight/brightness" (show . guard $ (read currentBacklight :: Int) + n) - --- | Don't let the brightness be obnoxious -guard :: Int -> Int -guard = gu 2000 . gl 0 - where gu m n = if n > m then m else n - gl m n = if n < m then m else n diff --git a/src/XMonad/Util/Keyboard.hs b/src/XMonad/Util/Keyboard.hs --- a/src/XMonad/Util/Keyboard.hs +++ b/src/XMonad/Util/Keyboard.hs @@ -39,20 +39,19 @@ instance Default KbLayout where def = Simple "us" --- | executable to yield current layout -showKBLayout :: IO () -showKBLayout = putStrLn =<< (show <$> parseKB) +-- | Pretty-print current layout +showKBLayout :: IO String +showKBLayout = show <$> parseKB -- | Get current keyboard layout parseKB :: IO KbLayout parseKB = do out <- lines <$> readCreateProcess (shell "setxkbmap -query") "" let strip = dropWhile (==' ') . drop 1 . dropWhile (/=':') .* (!!) - let line = strip out - if length out == 3 then - pure (Simple (line 2)) - else - pure (Regional (line 2) (line 3)) + line = strip out + if length out == 3 + then pure (Simple (line 2)) + else pure (Regional (line 2) (line 3)) -- | Tibetan keyboard layout tibetan :: KbLayout diff --git a/src/XMonad/Util/MediaKeys.hs b/src/XMonad/Util/MediaKeys.hs --- a/src/XMonad/Util/MediaKeys.hs +++ b/src/XMonad/Util/MediaKeys.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TupleSections #-} + -- | Bind media keys using dbus -- Requires amixer to control volume. module XMonad.Util.MediaKeys (-- * default keybindings @@ -8,36 +10,43 @@ , audioPlayPause ) where +import Control.Arrow (first) import qualified Data.Map as M import Graphics.X11.ExtraTypes.XF86 import Graphics.X11.Types import XMonad.Core import XMonad.Util.Volume --- | Given your keymaps, add the media keybindings +-- | Given your keymaps, add the media keybindings. Currently they are set up +-- for Spotify. mediaKeys :: M.Map (KeyMask, KeySym) (X ()) -> M.Map (KeyMask, KeySym) (X ()) -mediaKeys = M.fromList . (++) mediaKeyList . M.toList +mediaKeys = M.union mediaKeyMap + where mediaKeyMap = M.fromList mediaKeyList mediaKeyList :: [((KeyMask, KeySym), X ())] -mediaKeyList = [ ((0, xF86XK_AudioNext), audioNext) - , ((0, xF86XK_AudioPrev), audioPrev) - , ((0, xF86XK_AudioPlay), audioPlayPause) - , ((0, xF86XK_AudioMute), toggleMute) - , ((0, xF86XK_AudioLowerVolume), lowerVolume (5 :: Word)) - , ((0, xF86XK_AudioRaiseVolume), raiseVolume (5 :: Word)) - ] +mediaKeyList = go <$> [ (xF86XK_AudioNext, audioNext) + , (xF86XK_AudioPrev, audioPrev) + , (xF86XK_AudioPlay, audioPlayPause) + , (xF86XK_AudioMute, toggleMute) + , (xF86XK_AudioLowerVolume, lowerVolume five) + , (xF86XK_AudioRaiseVolume, raiseVolume five) + ] + where go = first (0 ,) + five :: Word + five = 5 + -- | Helper function for use with dbus sp :: String -> X () sp = spawn . (++) "dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player." -- | Action in the 'X' monad to go to next audioNext :: X () -audioNext = sp "Next" +audioNext = sp "Next" -- | Action in the 'X' monad to go the previous audioPrev :: X () -audioPrev = sp "Previous" +audioPrev = sp "Previous" -- | Action in the 'X' monad to play/pause audioPlayPause :: X () diff --git a/src/XMonad/Util/Volume.hs b/src/XMonad/Util/Volume.hs --- a/src/XMonad/Util/Volume.hs +++ b/src/XMonad/Util/Volume.hs @@ -1,9 +1,11 @@ -- | Utils to use to control volume via amixer -module XMonad.Util.Volume where +module XMonad.Util.Volume ( toggleMute + , raiseVolume + , lowerVolume + ) where import XMonad --- | Generate action in the X monad to vol :: String -> X () vol = spawn . (++) "amixer -D pulse sset Master " diff --git a/xmonad-vanessa.cabal b/xmonad-vanessa.cabal --- a/xmonad-vanessa.cabal +++ b/xmonad-vanessa.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: xmonad-vanessa -version: 0.2.0.4 +version: 1.0.0.0 license: BSD3 license-file: LICENSE copyright: 2017-2018 Vanessa McHale @@ -22,13 +22,12 @@ library exposed-modules: - XMonad.Config.Vanessa - XMonad.Util.Brightness XMonad.Util.Keyboard XMonad.Util.Volume XMonad.Util.MediaKeys hs-source-dirs: src - default-language: Haskell2010 + default-language: Haskell98 + other-extensions: TupleSections ghc-options: -Wall build-depends: base >=4.8 && <5, @@ -37,27 +36,25 @@ composition-prelude -any, containers -any, process -any, - X11 -any, - transformers -any - - if !impl(ghc >=8.0) - build-depends: - semigroups -any + X11 -any executable xmonad main-is: Main.hs hs-source-dirs: app - default-language: Haskell2010 - ghc-options: -O2 + default-language: Haskell98 + ghc-options: -O2 -Wall build-depends: base -any, - xmonad-vanessa -any + xmonad-vanessa -any, + xmonad -any, + xmonad-contrib -any, + containers -any executable getkb main-is: ParseKBLayout.hs hs-source-dirs: app - default-language: Haskell2010 - ghc-options: -O2 + default-language: Haskell98 + ghc-options: -O2 -Wall build-depends: base -any, xmonad-vanessa -any @@ -66,7 +63,7 @@ type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test - default-language: Haskell2010 + default-language: Haskell98 ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base -any,