REF rearranged library to be more sane

This commit is contained in:
Nathan Dwarshuis 2020-04-01 20:17:47 -04:00
parent 45799ae512
commit 43c68924a5
23 changed files with 259 additions and 204 deletions

View File

@ -1,21 +1,19 @@
module Main (main) where
import Data.List
import Xmobar.Plugins.Bluetooth
import Xmobar.Plugins.IntelBacklight
import Xmobar.Plugins.Screensaver
import Xmobar.Plugins.VPN
import qualified Theme as T
import Data.List
import Xmobar
import Xmobar.Common
import XMonad (getXMonadDir)
-- wrapColor :: String -> String -> String
-- wrapColor c s = "<fc=" ++ c ++ ">" ++ s ++ "</fc>"
import XMonad.Hooks.DynamicLog (xmobarColor)
import qualified XMonad.Internal.Theme as T
sep :: String
sep = wrapColor T.backdropFgColor " : "
sep = xmobarColor T.backdropFgColor "" " : "
myTemplate :: String
myTemplate = formatTemplate left right
@ -125,9 +123,9 @@ config confDir = defaultConfig
, Run $ Locks
[ "-N", "<fn=3>\x1f13d</fn>"
, "-n", wrapColor T.backdropFgColor "<fn=3>\x1f13d</fn>"
, "-n", xmobarColor T.backdropFgColor "" "<fn=3>\x1f13d</fn>"
, "-C", "<fn=3>\x1f132</fn>"
, "-c", wrapColor T.backdropFgColor "<fn=3>\x1f132</fn>"
, "-c", xmobarColor T.backdropFgColor "" "<fn=3>\x1f132</fn>"
, "-s", ""
, "-S", ""
, "-d", "<fn=3> </fn>"

View File

@ -4,24 +4,15 @@
module Main (main) where
import Capture
import General
import Internal.DMenu
import Power
import ACPI
import DBus.Common
import Process
import SendXMsg
import Shell
import qualified Theme as T
import WorkspaceMon
import Control.Concurrent
import Data.List (isPrefixOf, sortBy, sortOn)
import Data.Maybe (isJust)
import Data.Monoid (All (..))
import Data.List
( isPrefixOf
, sortBy
, sortOn
)
import Data.Maybe (isJust)
import Data.Monoid (All (..))
import Graphics.X11.Types
import Graphics.X11.Xlib.Atom
@ -30,23 +21,36 @@ import Graphics.X11.Xlib.Extras
import System.IO
import System.Process
import Xmobar.Common
import XMonad
import XMonad.Actions.CopyWindow
import XMonad.Actions.CycleWS
import XMonad.Actions.PhysicalScreens
import XMonad.Actions.Warp
import XMonad.Hooks.DynamicLog
( pad
, wrap
, xmobarColor
)
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Internal.Command.Desktop
import XMonad.Internal.Command.DMenu
import XMonad.Internal.Command.Power
import XMonad.Internal.Concurrent.ACPIEvent
import XMonad.Internal.Concurrent.ClientMessage
import XMonad.Internal.Concurrent.DynamicWorkspaces
import XMonad.Internal.DBus.Control
import XMonad.Internal.Process
import XMonad.Internal.Shell
import qualified XMonad.Internal.Theme as T
import XMonad.Layout.MultiToggle
import XMonad.Layout.NoBorders
import XMonad.Layout.NoFrillsDecoration
import XMonad.Layout.PerWorkspace
import XMonad.Layout.Renamed
import XMonad.Layout.Tabbed
import qualified XMonad.StackSet as W
import qualified XMonad.StackSet as W
import XMonad.Util.EZConfig
import XMonad.Util.NamedActions
@ -231,21 +235,21 @@ myWindowSetXinerama
W.StackSet String (layout a1) a2 ScreenId ScreenDetail -> String
myWindowSetXinerama ws = unwords [onScreen, offScreen, sep, layout, nWindows]
where
onScreen = wrapColorBg hilightFgColor hilightBgColor
$ (\s -> " " ++ s ++ " ")
onScreen = xmobarColor hilightFgColor hilightBgColor
$ pad
$ unwords
$ map (fmtTags . W.tag . W.workspace)
$ sortBy compareXCoord
$ W.current ws : W.visible ws
offScreen = wrapColor T.backdropFgColor
offScreen = xmobarColor T.backdropFgColor ""
$ unwords
$ map W.tag
$ filter (isJust . W.stack)
$ sortOn W.tag
$ W.hidden ws
sep = wrapColor T.backdropFgColor ":"
sep = xmobarColor T.backdropFgColor "" ":"
layout = description $ W.layout $ W.workspace $ W.current ws
nWindows = (\s -> "(" ++ s ++ ")")
nWindows = wrap "(" ")"
$ show
$ length
$ W.integrate'
@ -255,7 +259,7 @@ myWindowSetXinerama ws = unwords [onScreen, offScreen, sep, layout, nWindows]
hilightBgColor = "#8fc7ff"
hilightFgColor = T.blend' 0.5 hilightBgColor T.fgColor
fmtTags t = if t == W.currentTag ws
then wrapColorBg T.fgColor hilightBgColor t
then xmobarColor T.fgColor hilightBgColor t
else t
compareXCoord

View File

@ -1,35 +0,0 @@
module Capture
( runAreaCapture
, runDesktopCapture
, runScreenCapture
)
where
import Shell
import System.Directory
import XMonad.Core
getScreenshotDir :: IO FilePath
getScreenshotDir = do
h <- getHomeDirectory
return $ h ++ "/Pictures/screenshots"
runFlameshot :: String -> X ()
runFlameshot mode = do
ssDir <- io getScreenshotDir
spawnCmd "flameshot" $ mode : ["-p", ssDir]
-- TODO this will steal focus from the current window (and puts it
-- in the root window?) ...need to fix
runAreaCapture :: X ()
runAreaCapture = runFlameshot "gui"
-- myWindowCap = "screencap -w" --external script
runScreenCapture :: X ()
runScreenCapture = runFlameshot "screen"
runDesktopCapture :: X ()
runDesktopCapture = runFlameshot "full"

View File

@ -1,6 +1,12 @@
module Internal.DMenu where
import Shell
module XMonad.Internal.Command.DMenu
( runCmdMenu
, runAppMenu
, runClipMenu
, runWinMenu
, runNetMenu
, runDevMenu
, runShowKeys
) where
import Control.Monad.Reader
@ -14,6 +20,7 @@ import Graphics.X11.Xrandr
import System.IO
import XMonad.Core
import XMonad.Internal.Shell
import XMonad.StackSet
import XMonad.Util.NamedActions
import XMonad.Util.Run
@ -77,10 +84,8 @@ runShowKeys x = addName "Show Keybindings" $ do
Nothing -> io $ putStrLn "fail"
where cmd name = fmtCmd myDmenuCmd
[ "-dmenu"
, "-m"
, name
, "-p"
, "commands"
, "-m", name
, "-p", "commands"
, "-theme-str"
, "'#element.selected.normal { background-color: #a200ff; }'"
]

View File

@ -1,23 +1,51 @@
module General where
--------------------------------------------------------------------------------
-- | General commands
import Notify
import Shell
module XMonad.Internal.Command.Desktop
( myTerm
, runTerm
, runCalc
, runBrowser
, runEditor
, runFileManager
, runTogglePlay
, runPrevTrack
, runNextTrack
, runStopPlay
, runVolumeDown
, runVolumeUp
, runVolumeMute
, runToggleBluetooth
, runIncBacklight
, runDecBacklight
, runMinBacklight
, runMaxBacklight
, runToggleDPMS
, runRestart
, runRecompile
, runAreaCapture
, runScreenCapture
, runDesktopCapture
) where
import DBus.IntelBacklight
import DBus.Screensaver
import Control.Monad (void)
import Control.Monad (void)
import System.Directory (getHomeDirectory)
import XMonad.Actions.Volume
import XMonad.Core
import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.DBus.Screensaver
import XMonad.Internal.Notify
import XMonad.Internal.Shell
import XMonad.Operations
--------------------------------------------------------------------------------
-- | Some nice apps
myTerm :: String
myTerm = "urxvt"
runTerm :: X ()
runTerm = spawn myTerm
@ -104,3 +132,29 @@ runRecompile = do
#!&& fmtCmd "stack" ["install", ":xmonad"]
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
--------------------------------------------------------------------------------
-- | Screen capture commands
getScreenshotDir :: IO FilePath
getScreenshotDir = do
h <- getHomeDirectory
return $ h ++ "/Pictures/screenshots"
runFlameshot :: String -> X ()
runFlameshot mode = do
ssDir <- io getScreenshotDir
spawnCmd "flameshot" $ mode : ["-p", ssDir]
-- TODO this will steal focus from the current window (and puts it
-- in the root window?) ...need to fix
runAreaCapture :: X ()
runAreaCapture = runFlameshot "gui"
-- myWindowCap = "screencap -w" --external script
runScreenCapture :: X ()
runScreenCapture = runFlameshot "screen"
runDesktopCapture :: X ()
runDesktopCapture = runFlameshot "full"

View File

@ -1,4 +1,7 @@
module Power
--------------------------------------------------------------------------------
-- | Commands for controlling power
module XMonad.Internal.Command.Power
( runHibernate
, runOptimusPrompt
, runPowerOff
@ -8,14 +11,7 @@ module Power
, runSuspend
, runSuspendPrompt
, runQuitPrompt
)
where
--------------------------------------------------------------------------------
-- | Commands for controlling power
import Shell
import qualified Theme as T
) where
import Control.Arrow (first)
@ -23,13 +19,15 @@ import qualified Data.Map as M
import Graphics.X11.Types
import XMonad.Core
import XMonad.Prompt
import XMonad.Prompt.ConfirmPrompt
import System.Directory
import System.Exit
import XMonad.Core
import XMonad.Internal.Shell
import qualified XMonad.Internal.Theme as T
import XMonad.Prompt
import XMonad.Prompt.ConfirmPrompt
--------------------------------------------------------------------------------
-- | Core commands

View File

@ -1,29 +1,28 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module ACPI
module XMonad.Internal.Concurrent.ACPIEvent
( ACPIEvent(..)
, isDischarging
, runPowermon
, handleACPI
) where
import Power
import SendXMsg
import Control.Exception
import Control.Monad
import Data.ByteString hiding (readFile)
import Data.ByteString.Char8 as C hiding (readFile)
import Data.ByteString hiding (readFile)
import Data.ByteString.Char8 as C hiding (readFile)
import Data.Connection
import System.IO.Streams.Internal as S (read)
import Text.Read (readMaybe)
import System.IO.Streams.Internal as S (read)
import System.IO.Streams.UnixSocket
import Text.Read (readMaybe)
import XMonad.Core
import XMonad.Internal.Command.Power
import XMonad.Internal.Concurrent.ClientMessage
data ACPIEvent = Power
| Sleep

View File

@ -1,4 +1,8 @@
module SendXMsg (XMsgType(..), sendXMsg, splitXMsg) where
module XMonad.Internal.Concurrent.ClientMessage
( XMsgType(..)
, sendXMsg
, splitXMsg
) where
import Data.Char

View File

@ -25,20 +25,16 @@
-- 2) Xsane (see Gimp)
-- 3) Virtualbox (should always be by itself anyways)
module WorkspaceMon
module XMonad.Internal.Concurrent.DynamicWorkspaces
( DynWorkspace(..)
, appendViewShift
, removeDynamicWorkspace
, runWorkspaceMon
, spawnOrSwitch
, doSink
)
where
) where
import Process
import SendXMsg
import qualified Data.Map as M
import qualified Data.Map as M
import Data.Maybe
import Control.Concurrent
@ -54,7 +50,7 @@ import Graphics.X11.Xlib.Extras
import Graphics.X11.Xlib.Misc
import Graphics.X11.Xlib.Types
import System.Process (Pid)
import System.Process (Pid)
import XMonad.Actions.DynamicWorkspaces
import XMonad.Core
@ -63,10 +59,13 @@ import XMonad.Core
, X
, withWindowSet
)
import XMonad.Hooks.ManageHelpers (MaybeManageHook)
import XMonad.Hooks.ManageHelpers (MaybeManageHook)
import XMonad.Internal.Concurrent.ClientMessage
import XMonad.Internal.Process
import XMonad.ManageHook
import XMonad.Operations
import qualified XMonad.StackSet as W
import qualified XMonad.StackSet as W
--------------------------------------------------------------------------------
-- | Dynamic Workspace datatype

View File

@ -1,9 +1,14 @@
{-# LANGUAGE OverloadedStrings #-}
module DBus.Internal where
module XMonad.Internal.DBus.Common
( callMethod
, addMatchCallback
) where
import DBus
import DBus.Client
import DBus
import DBus.Client
-- TODO export the bus name (org.xmonad)
-- TODO not all methods warrent that we wait for a reply?
callMethod :: MethodCall -> IO (Maybe [Variant])

View File

@ -1,16 +1,16 @@
{-# LANGUAGE OverloadedStrings #-}
module DBus.Common
module XMonad.Internal.DBus.Control
( Client
, startXMonadService
, stopXMonadService)
where
import DBus.IntelBacklight
import DBus.Screensaver
, stopXMonadService
) where
import DBus.Client
import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.DBus.Screensaver
startXMonadService :: IO Client
startXMonadService = do
client <- connectSession

View File

@ -3,7 +3,7 @@
--------------------------------------------------------------------------------
-- | DBus module for Intel Backlight control
module DBus.IntelBacklight
module XMonad.Internal.DBus.IntelBacklight
( callDecBrightness
, callGetBrightness
, callIncBrightness
@ -13,19 +13,17 @@ module DBus.IntelBacklight
, matchSignal
) where
import Control.Monad (void)
import Control.Monad (void)
import Data.Char
import Data.Char
import Data.Int (Int16, Int32)
import Data.Text (pack, unpack)
import Data.Text.IO as T (readFile, writeFile)
import Data.Int (Int16, Int32)
import DBus
import DBus.Client
-- use strict IO here, the data in these files is literally 1-10 bytes
import Data.Text (pack, unpack)
import Data.Text.IO as T (readFile, writeFile)
import DBus
import DBus.Client
import DBus.Internal
import XMonad.Internal.DBus.Common
--------------------------------------------------------------------------------
-- | Low level sysfs functions
@ -36,6 +34,8 @@ import DBus.Internal
-- of 0 turn the monitor off). The latter is the raw brightness scaled from 0 to
-- 10000 (which can easily be converted to a percent).
-- use strict IO here, the data in these files is literally 1-10 bytes
-- TODO this is hacky but not sure if there is a cleaner way to enforce type
-- checking between these without making two new types and adding Integral
-- instances to both of them

View File

@ -3,25 +3,24 @@
--------------------------------------------------------------------------------
-- | DBus module for X11 screensave/DPMS control
module DBus.Screensaver
module XMonad.Internal.DBus.Screensaver
( exportScreensaver
, callToggle
, callQuery
, matchSignal
) where
import Control.Monad (void)
import Control.Monad (void)
import DBus
import DBus.Client
import DBus.Internal
import Graphics.X11.Xlib.Display
import Graphics.X11.XScreenSaver
import Shell
import XMonad
import XMonad.Internal.DBus.Common
import XMonad.Internal.Shell
--------------------------------------------------------------------------------
-- | Low-level functions
@ -88,6 +87,7 @@ bodyGetCurrentState :: [Variant] -> Maybe SSState
bodyGetCurrentState [b] = fromVariant b :: Maybe SSState
bodyGetCurrentState _ = Nothing
--------------------------------------------------------------------------------
-- | Exported haskell API
exportScreensaver :: Client -> IO ()

View File

@ -1,32 +1,32 @@
{-# LANGUAGE LambdaCase #-}
module Notify
module XMonad.Internal.Notify
( Note(..)
, Body(..)
, defNote
, defNoteInfo
, defNoteError
, fmtNotifyCmd
)
where
) where
import Shell
import Data.Maybe
import Data.Maybe
import DBus.Notify
import DBus.Notify
import XMonad.Internal.Shell
defNote :: Note
defNote = blankNote { summary = "\"xmonad\"" }
defNoteInfo :: Note
defNoteInfo = defNote
{ appImage = Just $ Icon "dialog-information-symbolic" }
defNoteError :: Note
defNoteError = defNote
{ appImage = Just $ Icon "dialog-error-symbolic" }
parseBody :: Body -> Maybe String
parseBody (Text s) = Just s
parseBody _ = Nothing
parseBody _ = Nothing
fmtNotifyCmd :: Note -> String
fmtNotifyCmd note =

View File

@ -1,6 +1,10 @@
{-# LANGUAGE LambdaCase #-}
module Process where
module XMonad.Internal.Process
( waitUntilExit
, killPID
, spawnPipe'
) where
import Control.Concurrent
import Control.Exception

View File

@ -1,10 +1,13 @@
module Shell where
module XMonad.Internal.Shell
( fmtCmd
, spawnCmd
, (#!&&)
, (#!||)
, (#!>>)
) where
import XMonad
myTerm :: String
myTerm = "urxvt"
fmtCmd :: String -> [String] -> String
fmtCmd cmd args = unwords $ cmd : args

View File

@ -1,13 +1,35 @@
{-# LANGUAGE LambdaCase #-}
module Theme where
module XMonad.Internal.Theme
( baseColor
, bgColor
, fgColor
, bordersColor
, warningColor
, errorColor
, selectedFgColor
, selectedBgColor
, selectedBordersColor
, backdropBaseColor
, backdropFgColor
, backdropTextColor
, blend'
, darken'
, Slant(..)
, Weight(..)
, ThemeFont(..)
, fmtFontXFT
, font
, tabbedTheme
, promptTheme
) where
import Data.Char
import Data.Char
import Data.Colour
import Data.Colour.SRGB
import Data.Colour
import Data.Colour.SRGB
import Data.List
import Data.List
import qualified XMonad.Layout.Decoration as D
import qualified XMonad.Prompt as P
@ -60,6 +82,9 @@ darken' wt = sRGB24show . darken wt . sRGB24read
-- Fonts
-- TODO use the font package from contrib
-- https://hackage.haskell.org/package/xmonad-contrib-0.16/docs/XMonad-Util-Font.html
data Slant = Roman
| Italic
| Oblique
@ -103,6 +128,7 @@ fmtFontXFT ThemeFont
Just d -> e ++ "=" ++ map toLower (show d)
Nothing -> ""
font :: ThemeFont
font = ThemeFont
{ family = "DejaVu Sans"
, size = Just 10
@ -114,6 +140,7 @@ font = ThemeFont
-- Complete themes
tabbedTheme :: D.Theme
tabbedTheme = D.def
{ D.fontName = fmtFontXFT font { weight = Just Bold }
@ -139,6 +166,7 @@ tabbedTheme = D.def
, D.windowTitleIcons = []
}
promptTheme :: P.XPConfig
promptTheme = P.def
{ P.font = fmtFontXFT font
, P.bgColor = bgColor

View File

@ -1,9 +0,0 @@
module Xmobar.Common where
import XMonad.Hooks.DynamicLog (xmobarColor)
wrapColor :: String -> String -> String
wrapColor fg = wrapColorBg fg ""
wrapColorBg :: String -> String -> String -> String
wrapColorBg = xmobarColor

View File

@ -1,13 +1,13 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Xmobar.Plugins.Bluetooth where
module Xmobar.Plugins.Bluetooth (Bluetooth(..)) where
import DBus
import DBus.Client
import Xmobar
import Xmobar.Common
import XMonad.Hooks.DynamicLog (xmobarColor)
data Bluetooth = Bluetooth (String, String, String) Int
deriving (Read, Show)
@ -31,5 +31,5 @@ instance Exec Bluetooth where
Right r -> fromVariant r
Left _ -> Nothing
fmtState = \case
Just s -> wrapColor (if s then colorOn else colorOff) text
Just s -> xmobarColor (if s then colorOn else colorOff) "" text
Nothing -> "N/A"

View File

@ -1,13 +1,13 @@
{-# LANGUAGE LambdaCase #-}
module Xmobar.Plugins.IntelBacklight where
module Xmobar.Plugins.IntelBacklight (IntelBacklight(..)) where
import Control.Concurrent
import Control.Monad
import Control.Concurrent
import Control.Monad
import DBus.IntelBacklight
import Xmobar
import Xmobar
import XMonad.Internal.DBus.IntelBacklight
newtype IntelBacklight = IntelBacklight String deriving (Read, Show)

View File

@ -1,14 +1,14 @@
{-# LANGUAGE LambdaCase #-}
module Xmobar.Plugins.Screensaver where
module Xmobar.Plugins.Screensaver (Screensaver(..)) where
import Control.Concurrent
import Control.Monad
import DBus.Screensaver
import Xmobar
import Xmobar.Common
import XMonad.Hooks.DynamicLog (xmobarColor)
import XMonad.Internal.DBus.Screensaver
newtype Screensaver = Screensaver (String, String, String)
deriving (Read, Show)
@ -21,6 +21,6 @@ instance Exec Screensaver where
forever (threadDelay 5000000)
where
fmtState = \case
Just s -> wrapColor (if s then colorOn else colorOff) text
Just s -> xmobarColor (if s then colorOn else colorOff) "" text
Nothing -> "N/A"

View File

@ -1,13 +1,13 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Xmobar.Plugins.VPN where
module Xmobar.Plugins.VPN (VPN(..)) where
import DBus
import DBus.Client
import Xmobar
import Xmobar.Common
import XMonad.Hooks.DynamicLog (xmobarColor)
data VPN = VPN (String, String, String) Int
deriving (Read, Show)
@ -31,5 +31,5 @@ instance Exec VPN where
Right r -> (fromVariant r :: Maybe String)
Left _ -> Nothing
fmtState = \case
Just s -> wrapColor (if s == "vpn" then colorOn else colorOff) text
Just s -> xmobarColor (if s == "vpn" then colorOn else colorOff) "" text
Nothing -> "N/A"

View File

@ -5,22 +5,20 @@ cabal-version: >=1.10
library
hs-source-dirs: lib
exposed-modules: SendXMsg
, ACPI
, Theme
, Notify
, Shell
, Power
, WorkspaceMon
, Capture
, General
, Internal.DMenu
, DBus.Common
, DBus.IntelBacklight
, DBus.Internal
, DBus.Screensaver
, Process
, Xmobar.Common
exposed-modules: XMonad.Internal.Concurrent.ClientMessage
, XMonad.Internal.Concurrent.ACPIEvent
, XMonad.Internal.Concurrent.DynamicWorkspaces
, XMonad.Internal.Theme
, XMonad.Internal.Notify
, XMonad.Internal.Shell
, XMonad.Internal.Command.Desktop
, XMonad.Internal.Command.DMenu
, XMonad.Internal.Command.Power
, XMonad.Internal.DBus.Common
, XMonad.Internal.DBus.IntelBacklight
, XMonad.Internal.DBus.Control
, XMonad.Internal.DBus.Screensaver
, XMonad.Internal.Process
, Xmobar.Plugins.Bluetooth
, Xmobar.Plugins.IntelBacklight
, Xmobar.Plugins.Screensaver
@ -54,7 +52,6 @@ executable xmonad
, directory >= 1.3.3.0
, process >= 1.6.5.0
, my-xmonad
, unix >= 2.7.2.2
, xmonad >= 0.13
, xmonad-contrib >= 0.13
default-language: Haskell2010
@ -67,5 +64,6 @@ executable xmobar
, my-xmonad
, xmobar
, xmonad >= 0.13
, xmonad-contrib >= 0.13
default-language: Haskell2010
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded