ENH use formatter for notify-send

This commit is contained in:
Nathan Dwarshuis 2020-03-18 12:17:39 -04:00
parent 63b4f5b564
commit 778dc38538
5 changed files with 81 additions and 30 deletions

View File

@ -5,13 +5,16 @@ module Main (main) where
import ACPI import ACPI
import SendXMsg import SendXMsg
import Notify
import Shell
import qualified Theme as T import qualified Theme as T
import Control.Monad (mapM_, forM, forM_, void, when) import Control.Monad (mapM_, forM, forM_, void, when)
import Data.List (find, sortBy, sortOn) import Data.List (find, sortBy, sortOn)
import qualified Data.Map.Lazy as M import qualified Data.Map.Lazy as M
import Data.Maybe (isJust, catMaybes) import Data.Maybe (catMaybes, isJust)
import Data.Monoid (All(..)) import Data.Monoid (All(..))
import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Atom
@ -222,6 +225,9 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
| otherwise -> return () | otherwise -> return ()
return (All True) return (All True)
| otherwise = return (All True) | otherwise = return (All True)
-- myEventHook DestroyWindowEvent { ev_window = w } = do
-- io $ print w
-- return (All True)
myEventHook _ = return (All True) myEventHook _ = return (All True)
removeEmptyWorkspaceByTag' tag = do removeEmptyWorkspaceByTag' tag = do
@ -298,27 +304,6 @@ runOptimusPrompt = do
-- shell commands -- shell commands
fmtCmd :: String -> [String] -> String
fmtCmd cmd args = unwords $ cmd : args
spawnCmd :: String -> [String] -> X ()
spawnCmd cmd args = spawn $ fmtCmd cmd args
(#!&&) :: String -> String -> String
cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB
infixr 0 #!&&
(#!||) :: String -> String -> String
cmdA #!|| cmdB = cmdA ++ " || " ++ cmdB
infixr 0 #!||
(#!>>) :: String -> String -> String
cmdA #!>> cmdB = cmdA ++ "; " ++ cmdB
infixr 0 #!>>
magicStringWS :: String magicStringWS :: String
magicStringWS = "%%%%%" magicStringWS = "%%%%%"
@ -327,9 +312,6 @@ spawnCmdOwnWS cmd args ws = spawn
$ fmtCmd cmd args $ fmtCmd cmd args
#!&& fmtCmd "xit-event" [magicStringWS, ws] #!&& fmtCmd "xit-event" [magicStringWS, ws]
-- spawnKill :: [String] -> X ()
-- spawnKill = mapM_ (spawn . ("killall " ++))
myTerm :: String myTerm :: String
myTerm = "urxvt" myTerm = "urxvt"
@ -382,7 +364,6 @@ getMonitorName = do
(Rectangle x y _ _) <- getFocusedScreen (Rectangle x y _ _) <- getFocusedScreen
return (fromIntegral x, fromIntegral y) return (fromIntegral x, fromIntegral y)
spawnDmenuCmd :: String -> [String] -> X () spawnDmenuCmd :: String -> [String] -> X ()
spawnDmenuCmd cmd args = do spawnDmenuCmd cmd args = do
name <- getMonitorName name <- getMonitorName
@ -485,8 +466,8 @@ runRecompile = do
where where
cmd c = fmtCmd "cd" [c] cmd c = fmtCmd "cd" [c]
#!&& fmtCmd "stack" ["install", ":xmonad"] #!&& fmtCmd "stack" ["install", ":xmonad"]
#!&& fmtCmd "notify-send" ["\"compilation succeeded\""] #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
#!|| fmtCmd "notify-send" ["\"compilation failed\""] #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
myMultimediaCtl :: String myMultimediaCtl :: String
myMultimediaCtl = "playerctl" myMultimediaCtl = "playerctl"
@ -512,14 +493,13 @@ runVolumeUp = void (raiseVolume 2)
runVolumeMute :: X () runVolumeMute :: X ()
runVolumeMute = void toggleMute runVolumeMute = void toggleMute
-- TODO make a formatter for the notify command
runToggleBluetooth :: X () runToggleBluetooth :: X ()
runToggleBluetooth = spawn runToggleBluetooth = spawn
$ "bluetoothctl show | grep -q \"Powered: no\"" $ "bluetoothctl show | grep -q \"Powered: no\""
#!&& "a=on" #!&& "a=on"
#!|| "a=off" #!|| "a=off"
#!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"] #!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"]
#!&& fmtCmd "notify-send" ["\"bluetooth powered $a\""] #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
-- TODO write these in haskell -- TODO write these in haskell
runIncBacklight :: X () runIncBacklight :: X ()

42
lib/Notify.hs Normal file
View File

@ -0,0 +1,42 @@
{-# LANGUAGE LambdaCase #-}
module Notify
( Note(..)
, Body(..)
, defNote
, defNoteInfo
, defNoteError
, fmtNotifyCmd
)
where
import Shell
import Data.Maybe
import DBus.Notify
defNote = blankNote { summary = "\"xmonad\"" }
defNoteInfo = defNote
{ appImage = Just $ Icon "dialog-information-symbolic" }
defNoteError = defNote
{ appImage = Just $ Icon "dialog-error-symbolic" }
parseBody :: Body -> Maybe String
parseBody (Text s) = Just s
parseBody _ = Nothing
fmtNotifyCmd :: Note -> String
fmtNotifyCmd note =
fmtCmd "notify-send" $ getIcon note
++ getSummary note
++ getBody note
where
-- TODO add the rest of the options as needed
getSummary = (:[]) . quote . summary
getIcon n = maybe [] (\i -> ["-i", case i of { Icon s -> s; File s -> s }])
$ appImage n
getBody n = maybeToList $ (fmap quote . parseBody) =<< body n
quote s = "\"" ++ s ++ "\""

24
lib/Shell.hs Normal file
View File

@ -0,0 +1,24 @@
module Shell where
import XMonad
fmtCmd :: String -> [String] -> String
fmtCmd cmd args = unwords $ cmd : args
spawnCmd :: String -> [String] -> X ()
spawnCmd cmd args = spawn $ fmtCmd cmd args
(#!&&) :: String -> String -> String
cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB
infixr 0 #!&&
(#!||) :: String -> String -> String
cmdA #!|| cmdB = cmdA ++ " || " ++ cmdB
infixr 0 #!||
(#!>>) :: String -> String -> String
cmdA #!>> cmdB = cmdA ++ "; " ++ cmdB
infixr 0 #!>>

View File

@ -8,11 +8,15 @@ library
exposed-modules: SendXMsg exposed-modules: SendXMsg
, ACPI , ACPI
, Theme , Theme
, Notify
, Shell
, Xmobar.Screensaver , Xmobar.Screensaver
build-depends: base build-depends: base
, X11 >= 1.9.1 , X11 >= 1.9.1
, colour >= 2.3.5 , colour >= 2.3.5
, xmonad >= 0.13
, xmonad-contrib >= 0.13 , xmonad-contrib >= 0.13
, fdo-notify
, xmobar , xmobar
ghc-options: -Wall -Werror -fno-warn-missing-signatures ghc-options: -Wall -Werror -fno-warn-missing-signatures
default-language: Haskell2010 default-language: Haskell2010

View File

@ -41,6 +41,7 @@ packages:
# #
extra-deps: extra-deps:
- iwlib-0.1.0 - iwlib-0.1.0
- fdo-notify-0.3.1
- github: ndwarshuis/xmobar - github: ndwarshuis/xmobar
commit: 4d750adcdecf5c1085ff583cf69392fcaf5dfaf7 commit: 4d750adcdecf5c1085ff583cf69392fcaf5dfaf7