ENH use formatter for notify-send

bin/xmonad.hs

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

lib/Notify.hs

@@ -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 ++ "\""

lib/Shell.hs

@@ -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 #!>>

my-xmonad.cabal

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

stack.yaml

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