From c81976467d317dd23489603f255fcf75bb043be9 Mon Sep 17 00:00:00 2001
From: Ben Boeckel <mathstuf@gmail.com>
Date: Wed, 5 Feb 2014 02:31:47 -0500
Subject: Add a "ready" check to MPD monitors

If the MPD server isn't responsive or the network is down, MPD will no
longer block xmobar from doing its job.
---
 src/Plugins/Monitors.hs     |  6 +++---
 src/Plugins/Monitors/MPD.hs | 13 ++++++++++++-
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/src/Plugins/Monitors.hs b/src/Plugins/Monitors.hs
index 9421170..baeb615 100644
--- a/src/Plugins/Monitors.hs
+++ b/src/Plugins/Monitors.hs
@@ -40,7 +40,7 @@ import Plugins.Monitors.Wireless
 #endif
 #ifdef LIBMPD
 import Plugins.Monitors.MPD
-import Plugins.Monitors.Common (runMB)
+import Plugins.Monitors.Common (runMD, runMBD)
 #endif
 #ifdef ALSA
 import Plugins.Monitors.Volume
@@ -155,8 +155,8 @@ instance Exec Monitors where
     start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r
 #endif
 #ifdef LIBMPD
-    start (MPD a r) = runM a mpdConfig runMPD r
-    start (AutoMPD a) = runMB a mpdConfig runMPD mpdWait
+    start (MPD a r) = runMD a mpdConfig runMPD r mpdReady
+    start (AutoMPD a) = runMBD a mpdConfig runMPD mpdWait mpdReady
 #endif
 #ifdef ALSA
     start (Volume m c a r) = runM a volumeConfig (runVolume m c) r
diff --git a/src/Plugins/Monitors/MPD.hs b/src/Plugins/Monitors/MPD.hs
index 0e5980c..1104608 100644
--- a/src/Plugins/Monitors/MPD.hs
+++ b/src/Plugins/Monitors/MPD.hs
@@ -12,7 +12,7 @@
 --
 -----------------------------------------------------------------------------
 
-module Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait ) where
+module Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where
 
 import Data.List
 import Plugins.Monitors.Common
@@ -63,6 +63,17 @@ mpdWait = do
     Left _ -> threadDelay 10000000
     _ -> return ()
 
+mpdReady :: [String] -> Monitor Bool
+mpdReady _ = do
+  response <- io $ M.withMPD M.ping
+  case response of
+    Right _         -> return True
+    -- Only cases where MPD isn't responding is an issue; bogus information at
+    -- least won't hold xmobar up.
+    Left M.NoMPD    -> return False
+    Left M.TimedOut -> return False
+    Left _          -> return True
+
 mopts :: [String] -> IO MOpts
 mopts argv =
   case getOpt Permute options argv of
-- 
cgit v1.2.3