ENH make better error messages for features
This commit is contained in:
parent
b28279794c
commit
81830a8e96
|
|
@ -40,12 +40,9 @@ import XMonad.Hooks.DynamicLog
|
|||
)
|
||||
import XMonad.Internal.Command.Power (hasBattery)
|
||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||
( curFileDep
|
||||
, maxFileDep
|
||||
)
|
||||
-- import XMonad.Internal.DBus.Common (xmonadBus)
|
||||
-- import XMonad.Internal.DBus.Control (pathExists)
|
||||
import XMonad.Internal.DBus.Screensaver (ssDep)
|
||||
import XMonad.Internal.DBus.Screensaver (ssSignalDep)
|
||||
import XMonad.Internal.Dependency
|
||||
-- import XMonad.Internal.Shell (fmtCmd)
|
||||
import qualified XMonad.Internal.Theme as T
|
||||
|
|
@ -226,20 +223,8 @@ dateCmd = CmdSpec
|
|||
-- some commands depend on the presence of interfaces that can only be
|
||||
-- determined at runtime; define these checks here
|
||||
|
||||
-- noSetup :: Monad m => a -> m (Maybe a)
|
||||
-- noSetup = return . Just
|
||||
|
||||
-- toJust :: a -> Bool -> Maybe a
|
||||
-- toJust x b = if b then Just x else Nothing
|
||||
|
||||
dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency
|
||||
dbusDep usesys bus obj iface mem = DBusEndpoint
|
||||
{ ddDbusBus = bus
|
||||
, ddDbusSystem = usesys
|
||||
, ddDbusObject = obj
|
||||
, ddDbusInterface = iface
|
||||
, ddDbusMember = mem
|
||||
}
|
||||
dbusDep usesys bus obj iface mem = DBusEndpoint (Bus usesys bus) (Endpoint obj iface mem)
|
||||
|
||||
-- in the case of network interfaces, assume that the system uses systemd in
|
||||
-- which case ethernet interfaces always start with "en" and wireless
|
||||
|
|
@ -303,14 +288,15 @@ getWireless = do
|
|||
getEthernet :: IO (MaybeExe CmdSpec)
|
||||
getEthernet = do
|
||||
i <- readInterface isEthernet
|
||||
evalFeature $ maybe BlankFeature (featureRun [dep] . ethernetCmd) i
|
||||
evalFeature $ maybe BlankFeature (featureRun "ethernet status indicator" [dep] . ethernetCmd) i
|
||||
where
|
||||
dep = dbusDep True devBus devPath devInterface $ Method_ devGetByIP
|
||||
|
||||
getBattery :: BarFeature
|
||||
getBattery = Feature
|
||||
{ ftrAction = batteryCmd
|
||||
, ftrSilent = False
|
||||
, ftrName = "battery level indicator"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [IOTest hasBattery]
|
||||
}
|
||||
|
||||
|
|
@ -319,7 +305,8 @@ type BarFeature = Feature CmdSpec
|
|||
getVPN :: BarFeature
|
||||
getVPN = Feature
|
||||
{ ftrAction = vpnCmd
|
||||
, ftrSilent = False
|
||||
, ftrName = "VPN status indicator"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [d, v]
|
||||
}
|
||||
where
|
||||
|
|
@ -329,7 +316,8 @@ getVPN = Feature
|
|||
getBt :: BarFeature
|
||||
getBt = Feature
|
||||
{ ftrAction = btCmd
|
||||
, ftrSilent = False
|
||||
, ftrName = "bluetooth status indicator"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [dep]
|
||||
}
|
||||
where
|
||||
|
|
@ -338,22 +326,25 @@ getBt = Feature
|
|||
getAlsa :: BarFeature
|
||||
getAlsa = Feature
|
||||
{ ftrAction = alsaCmd
|
||||
, ftrSilent = False
|
||||
, ftrChildren = [exe "alsactl"]
|
||||
, ftrName = "volume level indicator"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [Executable "alsactl"]
|
||||
}
|
||||
|
||||
getBl :: BarFeature
|
||||
getBl = Feature
|
||||
{ ftrAction = blCmd
|
||||
, ftrSilent = False
|
||||
, ftrChildren = [curFileDep, maxFileDep]
|
||||
, ftrName = "Intel backlight indicator"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [intelBacklightSignalDep]
|
||||
}
|
||||
|
||||
getSs :: BarFeature
|
||||
getSs = Feature
|
||||
{ ftrAction = ssCmd
|
||||
, ftrSilent = False
|
||||
, ftrChildren = [ssDep]
|
||||
, ftrName = "screensaver indicator"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [ssSignalDep]
|
||||
}
|
||||
|
||||
getAllCommands :: [MaybeExe CmdSpec] -> IO BarRegions
|
||||
|
|
|
|||
|
|
@ -47,8 +47,8 @@ myDmenuNetworks = "networkmanager_dmenu"
|
|||
--------------------------------------------------------------------------------
|
||||
-- | Other internal functions
|
||||
|
||||
spawnDmenuCmd :: [String] -> FeatureX
|
||||
spawnDmenuCmd = featureSpawnCmd myDmenuCmd
|
||||
spawnDmenuCmd :: String -> [String] -> FeatureX
|
||||
spawnDmenuCmd n = featureSpawnCmd n myDmenuCmd
|
||||
|
||||
themeArgs :: String -> [String]
|
||||
themeArgs hexColor =
|
||||
|
|
@ -63,7 +63,7 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity
|
|||
-- | Exported Commands
|
||||
|
||||
runDevMenu :: FeatureX
|
||||
runDevMenu = featureRun [exe myDmenuDevices] $ do
|
||||
runDevMenu = featureRun "device manager" [Executable myDmenuDevices] $ do
|
||||
c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
|
||||
spawnCmd myDmenuDevices
|
||||
$ ["-c", c]
|
||||
|
|
@ -71,7 +71,7 @@ runDevMenu = featureRun [exe myDmenuDevices] $ do
|
|||
++ myDmenuMatchingArgs
|
||||
|
||||
runBwMenu :: FeatureX
|
||||
runBwMenu = featureRun [exe myDmenuPasswords] $
|
||||
runBwMenu = featureRun "password manager" [Executable myDmenuPasswords] $
|
||||
spawnCmd myDmenuPasswords $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
|
||||
|
||||
-- TODO this is weirdly inverted
|
||||
|
|
@ -83,7 +83,8 @@ runShowKeys x = addName "Show Keybindings" $ do
|
|||
$ defNoteError { body = Just $ Text "could not display keymap" }
|
||||
|
||||
runDMenuShowKeys :: [((KeyMask, KeySym), NamedAction)] -> FeatureX
|
||||
runDMenuShowKeys kbs = featureRun [exe myDmenuCmd] $ io $ do
|
||||
runDMenuShowKeys kbs =
|
||||
featureRun "keyboard shortcut menu" [Executable myDmenuCmd] $ io $ do
|
||||
(h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
|
||||
forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
|
||||
where
|
||||
|
|
@ -91,13 +92,14 @@ runDMenuShowKeys kbs = featureRun [exe myDmenuCmd] $ io $ do
|
|||
++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
|
||||
|
||||
runCmdMenu :: FeatureX
|
||||
runCmdMenu = spawnDmenuCmd ["-show", "run"]
|
||||
runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
|
||||
|
||||
runAppMenu :: FeatureX
|
||||
runAppMenu = spawnDmenuCmd ["-show", "drun"]
|
||||
runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
|
||||
|
||||
runClipMenu :: FeatureX
|
||||
runClipMenu = featureRun [exe myDmenuCmd, exe "greenclip"]
|
||||
runClipMenu =
|
||||
featureRun "clipboard manager" [Executable myDmenuCmd, Executable "greenclip"]
|
||||
$ spawnCmd myDmenuCmd args
|
||||
where
|
||||
args = [ "-modi", "\"clipboard:greenclip print\""
|
||||
|
|
@ -106,10 +108,12 @@ runClipMenu = featureRun [exe myDmenuCmd, exe "greenclip"]
|
|||
] ++ themeArgs "#00c44e"
|
||||
|
||||
runWinMenu :: FeatureX
|
||||
runWinMenu = spawnDmenuCmd ["-show", "window"]
|
||||
runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
|
||||
|
||||
runNetMenu :: FeatureX
|
||||
runNetMenu = featureSpawnCmd myDmenuNetworks $ themeArgs "#ff3333"
|
||||
runNetMenu =
|
||||
featureSpawnCmd "network control menu" myDmenuNetworks $ themeArgs "#ff3333"
|
||||
|
||||
runAutorandrMenu :: FeatureX
|
||||
runAutorandrMenu = featureSpawnCmd myDmenuMonitors $ themeArgs "#ff0066"
|
||||
runAutorandrMenu =
|
||||
featureSpawnCmd "autorandr menu" myDmenuMonitors $ themeArgs "#ff0066"
|
||||
|
|
|
|||
|
|
@ -91,11 +91,12 @@ ethernetIface = "enp7s0f1"
|
|||
-- | Some nice apps
|
||||
|
||||
runTerm :: FeatureX
|
||||
runTerm = featureSpawn myTerm
|
||||
runTerm = featureSpawn "terminal" myTerm
|
||||
|
||||
runTMux :: FeatureX
|
||||
runTMux = featureRun [exe myTerm, exe "tmux", exe "bash"] cmd
|
||||
runTMux = featureRun "terminal multiplexer" deps cmd
|
||||
where
|
||||
deps = [Executable myTerm, Executable "tmux", Executable "bash"]
|
||||
cmd = spawn
|
||||
$ "tmux has-session"
|
||||
#!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
|
||||
|
|
@ -104,35 +105,37 @@ runTMux = featureRun [exe myTerm, exe "tmux", exe "bash"] cmd
|
|||
msg = "could not connect to tmux session"
|
||||
|
||||
runCalc :: FeatureX
|
||||
runCalc = featureRun [exe myTerm, exe "R"] $ spawnCmd myTerm ["-e", "R"]
|
||||
runCalc = featureRun "calculator" [Executable myTerm, Executable "R"]
|
||||
$ spawnCmd myTerm ["-e", "R"]
|
||||
|
||||
runBrowser :: FeatureX
|
||||
runBrowser = featureSpawn myBrowser
|
||||
runBrowser = featureSpawn "web browser" myBrowser
|
||||
|
||||
runEditor :: FeatureX
|
||||
runEditor = featureSpawnCmd myEditor
|
||||
runEditor = featureSpawnCmd "text editor" myEditor
|
||||
["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
|
||||
|
||||
runFileManager :: FeatureX
|
||||
runFileManager = featureSpawn "pcmanfm"
|
||||
runFileManager = featureSpawn "file browser" "pcmanfm"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Multimedia Commands
|
||||
|
||||
runMultimediaIfInstalled :: String -> FeatureX
|
||||
runMultimediaIfInstalled cmd = featureSpawnCmd myMultimediaCtl [cmd]
|
||||
runMultimediaIfInstalled :: String -> String -> FeatureX
|
||||
runMultimediaIfInstalled n cmd =
|
||||
featureSpawnCmd (n ++ " multimedia control") myMultimediaCtl [cmd]
|
||||
|
||||
runTogglePlay :: FeatureX
|
||||
runTogglePlay = runMultimediaIfInstalled "play-pause"
|
||||
runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause"
|
||||
|
||||
runPrevTrack :: FeatureX
|
||||
runPrevTrack = runMultimediaIfInstalled "previous"
|
||||
runPrevTrack = runMultimediaIfInstalled "previous track" "previous"
|
||||
|
||||
runNextTrack :: FeatureX
|
||||
runNextTrack = runMultimediaIfInstalled "next"
|
||||
runNextTrack = runMultimediaIfInstalled "next track" "next"
|
||||
|
||||
runStopPlay :: FeatureX
|
||||
runStopPlay = runMultimediaIfInstalled "stop"
|
||||
runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Volume Commands
|
||||
|
|
@ -146,42 +149,49 @@ playSound file = do
|
|||
-- paplay seems to have less latency than aplay
|
||||
spawnCmd "paplay" [p]
|
||||
|
||||
featureSound :: FilePath -> X () -> X () -> FeatureX
|
||||
featureSound file pre post = featureRun [exe "paplay"]
|
||||
featureSound :: String -> FilePath -> X () -> X () -> FeatureX
|
||||
featureSound n file pre post =
|
||||
featureRun ("volume " ++ n ++ " control") [Executable "paplay"]
|
||||
$ pre >> playSound file >> post
|
||||
|
||||
runVolumeDown :: FeatureX
|
||||
runVolumeDown = featureSound volumeChangeSound (return ()) $ void (lowerVolume 2)
|
||||
runVolumeDown = featureSound "up" volumeChangeSound (return ()) $ void (lowerVolume 2)
|
||||
|
||||
runVolumeUp :: FeatureX
|
||||
runVolumeUp = featureSound volumeChangeSound (return ()) $ void (raiseVolume 2)
|
||||
runVolumeUp = featureSound "down" volumeChangeSound (return ()) $ void (raiseVolume 2)
|
||||
|
||||
runVolumeMute :: FeatureX
|
||||
runVolumeMute = featureSound volumeChangeSound (void toggleMute) $ return ()
|
||||
runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return ()
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Notification control
|
||||
|
||||
runNotificationCmd :: String -> FeatureX
|
||||
runNotificationCmd cmd = featureSpawnCmd myNotificationCtrl [cmd]
|
||||
runNotificationCmd :: String -> String -> FeatureX
|
||||
runNotificationCmd n cmd =
|
||||
featureSpawnCmd (n ++ " control") myNotificationCtrl [cmd]
|
||||
|
||||
runNotificationClose :: FeatureX
|
||||
runNotificationClose = runNotificationCmd "close"
|
||||
runNotificationClose = runNotificationCmd "close notification" "close"
|
||||
|
||||
runNotificationCloseAll :: FeatureX
|
||||
runNotificationCloseAll = runNotificationCmd "close-all"
|
||||
runNotificationCloseAll =
|
||||
runNotificationCmd "close all notifications" "close-all"
|
||||
|
||||
runNotificationHistory :: FeatureX
|
||||
runNotificationHistory = runNotificationCmd "history-pop"
|
||||
runNotificationHistory =
|
||||
runNotificationCmd "see notification history" "history-pop"
|
||||
|
||||
runNotificationContext :: FeatureX
|
||||
runNotificationContext = runNotificationCmd "context"
|
||||
runNotificationContext =
|
||||
runNotificationCmd "open notification context" "context"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | System commands
|
||||
|
||||
runToggleBluetooth :: FeatureX
|
||||
runToggleBluetooth = featureRun [exe myBluetooth] $ spawn
|
||||
runToggleBluetooth =
|
||||
featureRun "bluetooth toggle" [Executable myBluetooth]
|
||||
$ spawn
|
||||
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
||||
#!&& "a=on"
|
||||
#!|| "a=off"
|
||||
|
|
@ -189,7 +199,8 @@ runToggleBluetooth = featureRun [exe myBluetooth] $ spawn
|
|||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
||||
|
||||
runToggleEthernet :: FeatureX
|
||||
runToggleEthernet = featureRun [exe "nmcli"] $ spawn
|
||||
runToggleEthernet = featureRun "ethernet toggle" [Executable "nmcli"]
|
||||
$ spawn
|
||||
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
||||
#!&& "a=connect"
|
||||
#!|| "a=disconnect"
|
||||
|
|
@ -197,14 +208,14 @@ runToggleEthernet = featureRun [exe "nmcli"] $ spawn
|
|||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed" }
|
||||
|
||||
runStartISyncTimer :: FeatureX
|
||||
runStartISyncTimer = featureRun [userUnit "mbsync.timer"]
|
||||
runStartISyncTimer = featureRun "isync timer" [userUnit "mbsync.timer"]
|
||||
$ spawn
|
||||
$ "systemctl --user start mbsync.timer"
|
||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync timer started" }
|
||||
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync timer failed to start" }
|
||||
|
||||
runStartISyncService :: FeatureX
|
||||
runStartISyncService = featureRun [userUnit "mbsync.service"]
|
||||
runStartISyncService = featureRun "isync" [userUnit "mbsync.service"]
|
||||
$ spawn
|
||||
$ "systemctl --user start mbsync.service"
|
||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync completed" }
|
||||
|
|
@ -248,25 +259,26 @@ getCaptureDir = do
|
|||
where
|
||||
fallback = (</> ".local/share") <$> getHomeDirectory
|
||||
|
||||
runFlameshot :: String -> FeatureX
|
||||
runFlameshot mode = featureRun [exe myCapture] $ do
|
||||
runFlameshot :: String -> String -> FeatureX
|
||||
runFlameshot n mode = featureRun n [Executable myCapture] $ do
|
||||
ssDir <- io getCaptureDir
|
||||
spawnCmd myCapture $ mode : ["-p", ssDir]
|
||||
|
||||
-- TODO this will steal focus from the current window (and puts it
|
||||
-- in the root window?) ...need to fix
|
||||
runAreaCapture :: FeatureX
|
||||
runAreaCapture = runFlameshot "gui"
|
||||
runAreaCapture = runFlameshot "screen area capture" "gui"
|
||||
|
||||
-- myWindowCap = "screencap -w" --external script
|
||||
|
||||
runDesktopCapture :: FeatureX
|
||||
runDesktopCapture = runFlameshot "full"
|
||||
runDesktopCapture = runFlameshot "fullscreen capture" "full"
|
||||
|
||||
runScreenCapture :: FeatureX
|
||||
runScreenCapture = runFlameshot "screen"
|
||||
runScreenCapture = runFlameshot "screen capture" "screen"
|
||||
|
||||
runCaptureBrowser :: FeatureX
|
||||
runCaptureBrowser = featureRun [exe myImageBrowser] $ do
|
||||
runCaptureBrowser =
|
||||
featureRun "screen capture browser" [Executable myImageBrowser] $ do
|
||||
dir <- io getCaptureDir
|
||||
spawnCmd myImageBrowser [dir]
|
||||
|
|
|
|||
|
|
@ -46,11 +46,7 @@ myOptimusManager = "optimus-manager"
|
|||
-- | Core commands
|
||||
|
||||
runScreenLock :: Feature (X ())
|
||||
runScreenLock = Feature
|
||||
{ ftrAction = spawn myScreenlock
|
||||
, ftrSilent = False
|
||||
, ftrChildren = [exe myScreenlock]
|
||||
}
|
||||
runScreenLock = featureSpawn "screen locker" myScreenlock
|
||||
|
||||
runPowerOff :: X ()
|
||||
runPowerOff = spawn "systemctl poweroff"
|
||||
|
|
@ -105,7 +101,8 @@ runOptimusPrompt' = do
|
|||
#!&& "killall xmonad"
|
||||
|
||||
runOptimusPrompt :: FeatureX
|
||||
runOptimusPrompt = featureRun [exe myOptimusManager] runOptimusPrompt'
|
||||
runOptimusPrompt = featureRun "graphics switcher" [Executable myOptimusManager]
|
||||
runOptimusPrompt'
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Universal power prompt
|
||||
|
|
|
|||
|
|
@ -95,7 +95,7 @@ acpiPath = "/var/run/acpid.socket"
|
|||
-- | Spawn a new thread that will listen for ACPI events on the acpid socket
|
||||
-- and send ClientMessage events when it receives them
|
||||
runPowermon :: FeatureIO
|
||||
runPowermon = featureRun [pathR acpiPath] listenACPI
|
||||
runPowermon = featureRun "ACPI event monitor" [pathR acpiPath] listenACPI
|
||||
|
||||
-- | Handle ClientMessage event containing and ACPI event (to be used in
|
||||
-- Xmonad's event hook)
|
||||
|
|
|
|||
|
|
@ -34,13 +34,7 @@ memRemoved :: MemberName
|
|||
memRemoved = memberName_ "InterfacesRemoved"
|
||||
|
||||
dbusDep :: MemberName -> Dependency
|
||||
dbusDep m = DBusEndpoint
|
||||
{ ddDbusBus = bus
|
||||
, ddDbusSystem = True
|
||||
, ddDbusObject = path
|
||||
, ddDbusInterface = interface
|
||||
, ddDbusMember = Signal_ m
|
||||
}
|
||||
dbusDep m = DBusEndpoint (Bus True bus) (Endpoint path interface $ Signal_ m)
|
||||
|
||||
addedDep :: Dependency
|
||||
addedDep = dbusDep memAdded
|
||||
|
|
@ -91,4 +85,5 @@ listenDevices = do
|
|||
$ playSoundMaybe p . f . signalBody
|
||||
|
||||
runRemovableMon :: FeatureIO
|
||||
runRemovableMon = featureRun [addedDep, removedDep] listenDevices
|
||||
runRemovableMon =
|
||||
featureRun "removeable device monitor" [addedDep, removedDep] listenDevices
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ module XMonad.Internal.DBus.Brightness.Common
|
|||
, brightnessExporter
|
||||
, callGetBrightness
|
||||
, matchSignal
|
||||
, signalDep
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
|
|
@ -16,6 +17,7 @@ import Data.Int (Int32)
|
|||
|
||||
import DBus
|
||||
import DBus.Client
|
||||
import qualified DBus.Introspection as I
|
||||
|
||||
import XMonad.Internal.DBus.Common
|
||||
import XMonad.Internal.Dependency
|
||||
|
|
@ -37,6 +39,7 @@ data BrightnessConfig a b = BrightnessConfig
|
|||
, bcGetMax :: IO a
|
||||
, bcPath :: ObjectPath
|
||||
, bcInterface :: InterfaceName
|
||||
, bcName :: String
|
||||
}
|
||||
|
||||
data BrightnessControls = BrightnessControls
|
||||
|
|
@ -47,25 +50,30 @@ data BrightnessControls = BrightnessControls
|
|||
}
|
||||
|
||||
brightnessControls :: BrightnessConfig a b -> BrightnessControls
|
||||
brightnessControls BrightnessConfig { bcPath = p, bcInterface = i } =
|
||||
brightnessControls bc =
|
||||
BrightnessControls
|
||||
{ bctlMax = cb memMax
|
||||
, bctlMin = cb memMin
|
||||
, bctlInc = cb memInc
|
||||
, bctlDec = cb memDec
|
||||
{ bctlMax = cb "max brightness" memMax
|
||||
, bctlMin = cb "min brightness" memMin
|
||||
, bctlInc = cb "increase brightness" memInc
|
||||
, bctlDec = cb "decrease brightness" memDec
|
||||
}
|
||||
where
|
||||
cb = callBacklight p i
|
||||
cb = callBacklight bc
|
||||
|
||||
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
||||
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
|
||||
reply <- callMethod $ methodCall p i memGet
|
||||
return $ reply >>= bodyGetBrightness
|
||||
|
||||
signalDep :: BrightnessConfig a b -> Dependency
|
||||
signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
|
||||
DBusEndpoint xmonadBus $ Endpoint p i $ Signal_ memCur
|
||||
|
||||
matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler
|
||||
matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
|
||||
client <- connectSession
|
||||
addMatch client brMatcher $ cb . bodyGetBrightness . signalBody
|
||||
-- TODO disconnect here?
|
||||
where
|
||||
brMatcher = matchAny
|
||||
{ matchPath = Just p
|
||||
|
|
@ -78,10 +86,11 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
|
|||
|
||||
brightnessExporter :: RealFrac b => [Dependency] -> BrightnessConfig a b
|
||||
-> Client -> FeatureIO
|
||||
brightnessExporter deps bc client = Feature
|
||||
brightnessExporter deps bc@BrightnessConfig { bcName = n } client = Feature
|
||||
{ ftrAction = exportBrightnessControls' bc client
|
||||
, ftrSilent = False
|
||||
, ftrChildren = deps
|
||||
, ftrName = n ++ " exporter"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = DBusBus xmonadBus:deps
|
||||
}
|
||||
|
||||
exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
|
||||
|
|
@ -98,6 +107,18 @@ exportBrightnessControls' bc client = do
|
|||
, autoMethod' memDec bcDec
|
||||
, autoMethod memGet (round <$> funget maxval :: IO Int32)
|
||||
]
|
||||
, interfaceSignals = [sig]
|
||||
}
|
||||
where
|
||||
sig = I.Signal
|
||||
{ I.signalName = memCur
|
||||
, I.signalArgs =
|
||||
[
|
||||
I.SignalArg
|
||||
{ I.signalArgName = "brightness"
|
||||
, I.signalArgType = TypeInt32
|
||||
}
|
||||
]
|
||||
}
|
||||
|
||||
emitBrightness :: RealFrac b => BrightnessConfig a b -> Client -> b -> IO ()
|
||||
|
|
@ -106,11 +127,12 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
|
|||
where
|
||||
sig = signal p i memCur
|
||||
|
||||
callBacklight :: ObjectPath -> InterfaceName -> MemberName -> FeatureIO
|
||||
callBacklight p i m =
|
||||
callBacklight :: BrightnessConfig a b -> String -> MemberName -> FeatureIO
|
||||
callBacklight BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
|
||||
Feature
|
||||
{ ftrAction = void $ callMethod $ methodCall p i m
|
||||
, ftrSilent = False
|
||||
, ftrName = unwords [n, controlName]
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [xDbusDep p i $ Method_ m]
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -6,8 +6,7 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
|
|||
, matchSignalIB
|
||||
, exportIntelBacklight
|
||||
, intelBacklightControls
|
||||
, curFileDep
|
||||
, maxFileDep
|
||||
, intelBacklightSignalDep
|
||||
, blPath
|
||||
) where
|
||||
|
||||
|
|
@ -78,6 +77,7 @@ intelBacklightConfig = BrightnessConfig
|
|||
, bcGetMax = getMaxRawBrightness
|
||||
, bcPath = blPath
|
||||
, bcInterface = interface
|
||||
, bcName = "Intel backlight"
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -89,6 +89,9 @@ curFileDep = pathRW curFile
|
|||
maxFileDep :: Dependency
|
||||
maxFileDep = pathR maxFile
|
||||
|
||||
intelBacklightSignalDep :: Dependency
|
||||
intelBacklightSignalDep = signalDep intelBacklightConfig
|
||||
|
||||
exportIntelBacklight :: Client -> FeatureIO
|
||||
exportIntelBacklight =
|
||||
brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig
|
||||
|
|
|
|||
|
|
@ -6,8 +6,9 @@ module XMonad.Internal.DBus.Common
|
|||
, callMethod'
|
||||
, addMatchCallback
|
||||
, xmonadBus
|
||||
, xmonadBusName
|
||||
, xDbusDep
|
||||
, initControls
|
||||
-- , initControls
|
||||
) where
|
||||
|
||||
import DBus
|
||||
|
|
@ -15,23 +16,22 @@ import DBus.Client
|
|||
|
||||
import XMonad.Internal.Dependency
|
||||
|
||||
xmonadBus :: BusName
|
||||
xmonadBus = busName_ "org.xmonad"
|
||||
xmonadBusName :: BusName
|
||||
xmonadBusName = busName_ "org.xmonad"
|
||||
|
||||
xmonadBus :: Bus
|
||||
xmonadBus = Bus False xmonadBusName
|
||||
|
||||
xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
|
||||
xDbusDep o i m = DBusEndpoint
|
||||
{ ddDbusBus = xmonadBus
|
||||
, ddDbusSystem = False
|
||||
, ddDbusObject = o
|
||||
, ddDbusInterface = i
|
||||
, ddDbusMember = m
|
||||
}
|
||||
xDbusDep o i m = DBusEndpoint xmonadBus $ Endpoint o i m
|
||||
|
||||
-- connectBus :: Bus -> IO (Maybe Client)
|
||||
|
||||
-- | Call a method and return its result if successful
|
||||
callMethod :: MethodCall -> IO (Maybe [Variant])
|
||||
callMethod mc = do
|
||||
client <- connectSession
|
||||
r <- callMethod' client (Just xmonadBus) mc
|
||||
r <- callMethod' client (Just xmonadBusName) mc
|
||||
disconnect client
|
||||
return r
|
||||
|
||||
|
|
@ -50,11 +50,11 @@ addMatchCallback rule cb = do
|
|||
client <- connectSession
|
||||
addMatch client rule $ cb . signalBody
|
||||
|
||||
initControls :: Client -> (Client -> FeatureIO) -> (FeatureIO -> a) -> IO a
|
||||
initControls client exporter controls = do
|
||||
let x = exporter client
|
||||
e <- evalFeature x
|
||||
case e of
|
||||
(Right c) -> c
|
||||
_ -> return ()
|
||||
return $ controls x
|
||||
-- initControls :: Client -> (Client -> FeatureIO) -> (FeatureIO -> a) -> IO a
|
||||
-- initControls client exporter controls = do
|
||||
-- let x = exporter client
|
||||
-- e <- evalFeature x
|
||||
-- case e of
|
||||
-- (Right c) -> c
|
||||
-- _ -> return ()
|
||||
-- return $ controls x
|
||||
|
|
|
|||
|
|
@ -19,7 +19,6 @@ import Data.Either
|
|||
import DBus
|
||||
import DBus.Client
|
||||
|
||||
-- import XMonad.Internal.DBus.Brightness.Common
|
||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||
import XMonad.Internal.DBus.Common
|
||||
import XMonad.Internal.DBus.Screensaver
|
||||
|
|
@ -42,7 +41,7 @@ startXMonadService = do
|
|||
|
||||
stopXMonadService :: Client -> IO ()
|
||||
stopXMonadService client = do
|
||||
void $ releaseName client xmonadBus
|
||||
void $ releaseName client xmonadBusName
|
||||
disconnect client
|
||||
|
||||
getDBusClient :: IO (Maybe Client)
|
||||
|
|
@ -54,7 +53,7 @@ getDBusClient = do
|
|||
|
||||
requestXMonadName :: Client -> IO ()
|
||||
requestXMonadName client = do
|
||||
res <- requestName client xmonadBus []
|
||||
res <- requestName client xmonadBusName []
|
||||
-- TODO if the client is not released on shutdown the owner will be
|
||||
-- different
|
||||
let msg | res == NamePrimaryOwner = Nothing
|
||||
|
|
@ -64,7 +63,7 @@ requestXMonadName client = do
|
|||
| otherwise = Just $ "unknown error when requesting " ++ xn
|
||||
forM_ msg putStrLn
|
||||
where
|
||||
xn = "'" ++ formatBusName xmonadBus ++ "'"
|
||||
xn = "'" ++ formatBusName xmonadBusName ++ "'"
|
||||
|
||||
pathExists :: Bool -> BusName -> ObjectPath -> IO Bool
|
||||
pathExists sysbus n p = do
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ module XMonad.Internal.DBus.Screensaver
|
|||
, matchSignal
|
||||
, ssPath
|
||||
, ssDep
|
||||
, ssSignalDep
|
||||
, SSControls(..)
|
||||
) where
|
||||
|
||||
|
|
@ -15,6 +16,7 @@ import Control.Monad (void)
|
|||
|
||||
import DBus
|
||||
import DBus.Client
|
||||
import qualified DBus.Introspection as I
|
||||
|
||||
import Graphics.X11.XScreenSaver
|
||||
import Graphics.X11.Xlib.Display
|
||||
|
|
@ -34,6 +36,10 @@ ssExecutable = "xset"
|
|||
ssDep :: Dependency
|
||||
ssDep = Executable ssExecutable
|
||||
|
||||
ssSignalDep :: Dependency
|
||||
ssSignalDep = DBusEndpoint xmonadBus $ Endpoint ssPath interface
|
||||
$ Signal_ memState
|
||||
|
||||
toggle :: IO SSState
|
||||
toggle = do
|
||||
st <- query
|
||||
|
|
@ -99,16 +105,12 @@ bodyGetCurrentState _ = Nothing
|
|||
|
||||
newtype SSControls = SSControls { ssToggle :: FeatureIO }
|
||||
|
||||
-- exportScreensaver :: Client -> IO SSControls
|
||||
-- exportScreensaver client = initControls client exportScreensaver' controls
|
||||
-- where
|
||||
-- controls _ = SSControls { ssToggle = callToggle }
|
||||
|
||||
exportScreensaver :: Client -> FeatureIO
|
||||
exportScreensaver client = Feature
|
||||
{ ftrAction = cmd
|
||||
, ftrSilent = False
|
||||
, ftrChildren = [ssDep]
|
||||
, ftrName = "screensaver interface"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [ssDep, DBusBus xmonadBus]
|
||||
}
|
||||
where
|
||||
cmd = export client ssPath defaultInterface
|
||||
|
|
@ -117,12 +119,24 @@ exportScreensaver client = Feature
|
|||
[ autoMethod memToggle $ emitState client =<< toggle
|
||||
, autoMethod memQuery query
|
||||
]
|
||||
, interfaceSignals = [sig]
|
||||
}
|
||||
sig = I.Signal
|
||||
{ I.signalName = memState
|
||||
, I.signalArgs =
|
||||
[
|
||||
I.SignalArg
|
||||
{ I.signalArgName = "enabled"
|
||||
, I.signalArgType = TypeBoolean
|
||||
}
|
||||
]
|
||||
}
|
||||
|
||||
callToggle :: FeatureIO
|
||||
callToggle = Feature
|
||||
{ ftrAction = cmd
|
||||
, ftrSilent = False
|
||||
, ftrName = "screensaver toggle"
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
|
||||
}
|
||||
where
|
||||
|
|
|
|||
|
|
@ -5,14 +5,16 @@ module XMonad.Internal.Dependency
|
|||
( MaybeExe
|
||||
, UnitType(..)
|
||||
, Dependency(..)
|
||||
, Bus(..)
|
||||
, Endpoint(..)
|
||||
, DBusMember(..)
|
||||
, Warning(..)
|
||||
, MaybeX
|
||||
, FeatureX
|
||||
, FeatureIO
|
||||
, Feature(..)
|
||||
, ioFeature
|
||||
, evalFeature
|
||||
, exe
|
||||
, systemUnit
|
||||
, userUnit
|
||||
, pathR
|
||||
|
|
@ -34,14 +36,16 @@ module XMonad.Internal.Dependency
|
|||
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
import Data.Bifunctor (bimap)
|
||||
import Data.List (find)
|
||||
import Data.Maybe (listToMaybe, maybeToList)
|
||||
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
|
||||
|
||||
import DBus
|
||||
import DBus.Client
|
||||
import qualified DBus.Introspection as I
|
||||
|
||||
import System.Directory (findExecutable, readable, writable)
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
|
||||
import XMonad.Core (X, io)
|
||||
|
|
@ -59,21 +63,23 @@ data DBusMember = Method_ MemberName
|
|||
| Property_ String
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Bus = Bus Bool BusName deriving (Eq, Show)
|
||||
|
||||
data Endpoint = Endpoint ObjectPath InterfaceName DBusMember deriving (Eq, Show)
|
||||
|
||||
data Dependency = Executable String
|
||||
| AccessiblePath FilePath Bool Bool
|
||||
| IOTest (IO (Maybe String))
|
||||
| DBusEndpoint
|
||||
{ ddDbusBus :: BusName
|
||||
, ddDbusSystem :: Bool
|
||||
, ddDbusObject :: ObjectPath
|
||||
, ddDbusInterface :: InterfaceName
|
||||
, ddDbusMember :: DBusMember
|
||||
}
|
||||
| DBusEndpoint Bus Endpoint
|
||||
| DBusBus Bus
|
||||
| Systemd UnitType String
|
||||
|
||||
data Warning = Silent | Default
|
||||
|
||||
data Feature a = Feature
|
||||
{ ftrAction :: a
|
||||
, ftrSilent :: Bool
|
||||
, ftrName :: String
|
||||
, ftrWarning :: Warning
|
||||
, ftrChildren :: [Dependency]
|
||||
}
|
||||
| ConstFeature a
|
||||
|
|
@ -91,16 +97,21 @@ ioFeature BlankFeature = BlankFeature
|
|||
evalFeature :: Feature a -> IO (MaybeExe a)
|
||||
evalFeature (ConstFeature x) = return $ Right x
|
||||
evalFeature BlankFeature = return $ Left []
|
||||
evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
|
||||
es <- mapM go c
|
||||
return $ case concat es of
|
||||
evalFeature Feature
|
||||
{ ftrAction = a
|
||||
, ftrName = n
|
||||
, ftrWarning = w
|
||||
, ftrChildren = c
|
||||
} = do
|
||||
procName <- getProgName
|
||||
es <- catMaybes <$> mapM evalDependency c
|
||||
return $ case es of
|
||||
[] -> Right a
|
||||
es' -> Left (if s then [] else es')
|
||||
es' -> Left $ fmtWarnings procName es'
|
||||
where
|
||||
go = fmap maybeToList . depInstalled
|
||||
|
||||
exe :: String -> Dependency
|
||||
exe = Executable
|
||||
fmtWarnings procName es = case w of
|
||||
Silent -> []
|
||||
Default -> fmap (fmtMsg procName "WARNING" . ((n ++ " disabled; ") ++)) es
|
||||
|
||||
pathR :: String -> Dependency
|
||||
pathR n = AccessiblePath n True False
|
||||
|
|
@ -123,18 +134,19 @@ type MaybeExe a = Either [String] a
|
|||
|
||||
type MaybeX = MaybeExe (X ())
|
||||
|
||||
featureRun :: [Dependency] -> a -> Feature a
|
||||
featureRun ds x = Feature
|
||||
featureRun :: String -> [Dependency] -> a -> Feature a
|
||||
featureRun n ds x = Feature
|
||||
{ ftrAction = x
|
||||
, ftrSilent = False
|
||||
, ftrName = n
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = ds
|
||||
}
|
||||
|
||||
featureSpawnCmd :: MonadIO m => String -> [String] -> Feature (m ())
|
||||
featureSpawnCmd cmd args = featureRun [exe cmd] $ spawnCmd cmd args
|
||||
featureSpawnCmd :: MonadIO m => String -> String -> [String] -> Feature (m ())
|
||||
featureSpawnCmd n cmd args = featureRun n [Executable cmd] $ spawnCmd cmd args
|
||||
|
||||
featureSpawn :: MonadIO m => String -> Feature (m ())
|
||||
featureSpawn cmd = featureSpawnCmd cmd []
|
||||
featureSpawn :: MonadIO m => String -> String -> Feature (m ())
|
||||
featureSpawn n cmd = featureSpawnCmd n cmd []
|
||||
|
||||
exeInstalled :: String -> IO (Maybe String)
|
||||
exeInstalled x = do
|
||||
|
|
@ -177,37 +189,69 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
|||
introspectMethod :: MemberName
|
||||
introspectMethod = memberName_ "Introspect"
|
||||
|
||||
dbusInstalled :: BusName -> Bool -> ObjectPath -> InterfaceName -> DBusMember
|
||||
-> IO (Maybe String)
|
||||
dbusInstalled bus usesystem objpath iface mem = do
|
||||
client <- if usesystem then connectSystem else connectSession
|
||||
reply <- call_ client (methodCall objpath introspectInterface introspectMethod)
|
||||
callMethod :: Bus -> ObjectPath -> InterfaceName -> MemberName -> IO (Either String [Variant])
|
||||
callMethod (Bus usesys bus) path iface mem = do
|
||||
client <- if usesys then connectSystem else connectSession
|
||||
reply <- call client (methodCall path iface mem)
|
||||
{ methodCallDestination = Just bus }
|
||||
let res = findMem =<< I.parseXML objpath =<< fromVariant
|
||||
=<< listToMaybe (methodReturnBody reply)
|
||||
disconnect client
|
||||
return $ case res of
|
||||
Just _ -> Nothing
|
||||
_ -> Just "some random dbus interface not found"
|
||||
where
|
||||
findMem obj = fmap (matchMem mem)
|
||||
$ find (\i -> I.interfaceName i == iface)
|
||||
$ I.objectInterfaces obj
|
||||
matchMem (Method_ n) = elem n . fmap I.methodName . I.interfaceMethods
|
||||
matchMem (Signal_ n) = elem n . fmap I.signalName . I.interfaceSignals
|
||||
matchMem (Property_ n) = elem n . fmap I.propertyName . I.interfaceProperties
|
||||
return $ bimap methodErrorMessage methodReturnBody reply
|
||||
|
||||
depInstalled :: Dependency -> IO (Maybe String)
|
||||
depInstalled (Executable n) = exeInstalled n
|
||||
depInstalled (IOTest t) = t
|
||||
depInstalled (Systemd t n) = unitInstalled t n
|
||||
depInstalled (AccessiblePath p r w) = pathAccessible p r w
|
||||
depInstalled DBusEndpoint { ddDbusBus = b
|
||||
, ddDbusSystem = s
|
||||
, ddDbusObject = o
|
||||
, ddDbusInterface = i
|
||||
, ddDbusMember = m
|
||||
} = dbusInstalled b s o i m
|
||||
dbusBusExists :: Bus -> IO (Maybe String)
|
||||
dbusBusExists (Bus usesystem bus) = do
|
||||
ret <- callMethod (Bus usesystem queryBus) queryPath queryIface queryMem
|
||||
return $ case ret of
|
||||
Left e -> Just e
|
||||
Right b -> let ns = bodyGetNames b in
|
||||
if bus' `elem` ns then Nothing
|
||||
else Just $ unwords ["name", singleQuote bus', "not found on dbus"]
|
||||
where
|
||||
bus' = formatBusName bus
|
||||
queryBus = busName_ "org.freedesktop.DBus"
|
||||
queryIface = interfaceName_ "org.freedesktop.DBus"
|
||||
queryPath = objectPath_ "/"
|
||||
queryMem = memberName_ "ListNames"
|
||||
bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [String]
|
||||
bodyGetNames _ = []
|
||||
|
||||
dbusEndpointExists :: Bus -> Endpoint -> IO (Maybe String)
|
||||
dbusEndpointExists b@(Bus _ bus) (Endpoint objpath iface mem) = do
|
||||
ret <- callMethod b objpath introspectInterface introspectMethod
|
||||
return $ case ret of
|
||||
Left e -> Just e
|
||||
Right body -> procBody body
|
||||
where
|
||||
procBody body = let res = findMem =<< I.parseXML objpath =<< fromVariant
|
||||
=<< listToMaybe body in
|
||||
case res of
|
||||
Just True -> Nothing
|
||||
_ -> Just $ fmtMsg' mem
|
||||
findMem = fmap (matchMem mem)
|
||||
. find (\i -> I.interfaceName i == iface)
|
||||
. I.objectInterfaces
|
||||
matchMem (Method_ n) = elemMember n I.methodName I.interfaceMethods
|
||||
matchMem (Signal_ n) = elemMember n I.signalName I.interfaceSignals
|
||||
matchMem (Property_ n) = elemMember n I.propertyName I.interfaceProperties
|
||||
elemMember n fname fmember = elem n . fmap fname . fmember
|
||||
fmtMem (Method_ n) = "method " ++ singleQuote (formatMemberName n)
|
||||
fmtMem (Signal_ n) = "signal " ++ singleQuote (formatMemberName n)
|
||||
fmtMem (Property_ n) = "property " ++ singleQuote n
|
||||
fmtMsg' m = unwords
|
||||
[ "could not find"
|
||||
, fmtMem m
|
||||
, "on interface"
|
||||
, singleQuote $ formatInterfaceName iface
|
||||
, "on bus"
|
||||
, formatBusName bus
|
||||
]
|
||||
|
||||
evalDependency :: Dependency -> IO (Maybe String)
|
||||
evalDependency (Executable n) = exeInstalled n
|
||||
evalDependency (IOTest t) = t
|
||||
evalDependency (Systemd t n) = unitInstalled t n
|
||||
evalDependency (AccessiblePath p r w) = pathAccessible p r w
|
||||
evalDependency (DBusEndpoint b e) = dbusEndpointExists b e
|
||||
evalDependency (DBusBus b) = dbusBusExists b
|
||||
|
||||
whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
|
||||
whenInstalled = flip ifInstalled skip
|
||||
|
|
@ -217,7 +261,7 @@ ifInstalled (Right x) _ = x
|
|||
ifInstalled _ alt = alt
|
||||
|
||||
warnMissing :: [MaybeExe a] -> IO ()
|
||||
warnMissing xs = warnMissing' $ fmap ("[WARNING] "++) $ concat $ [ m | (Left m) <- xs ]
|
||||
warnMissing xs = warnMissing' $ concat $ [ m | (Left m) <- xs ]
|
||||
|
||||
warnMissing' :: [String] -> IO ()
|
||||
warnMissing' = mapM_ putStrLn
|
||||
|
|
@ -235,3 +279,9 @@ executeFeature = applyFeature id
|
|||
|
||||
executeFeature_ :: Feature (IO ()) -> IO ()
|
||||
executeFeature_ = executeFeature ()
|
||||
|
||||
fmtMsg :: String -> String -> String -> String
|
||||
fmtMsg procName level msg = unwords [bracket procName, bracket level, msg]
|
||||
where
|
||||
bracket s = "[" ++ s ++ "]"
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue