diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,7 @@
+# 0.4.5
+
+ * GHC 7.10 compat
+
 # 0.4.4
 
  * Fix compilation with gtk 0.13.1
diff --git a/src/System/Information/Network.hs b/src/System/Information/Network.hs
--- a/src/System/Information/Network.hs
+++ b/src/System/Information/Network.hs
@@ -21,6 +21,8 @@
 import Safe ( atMay, initSafe, readDef )
 import System.Information.StreamInfo ( getParsedInfo )
 
+import Prelude
+
 -- | Returns a two-element list containing the current number of bytes
 -- received and transmitted via the given network interface (e.g. \"wlan0\"),
 -- according to the contents of the @\/proc\/dev\/net@ file.
diff --git a/src/System/Taffybar/LayoutSwitcher.hs b/src/System/Taffybar/LayoutSwitcher.hs
--- a/src/System/Taffybar/LayoutSwitcher.hs
+++ b/src/System/Taffybar/LayoutSwitcher.hs
@@ -27,7 +27,7 @@
 ) where
 
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Graphics.UI.Gtk
+import qualified Graphics.UI.Gtk as Gtk
 import Graphics.X11.Xlib.Extras (Event)
 import System.Taffybar.Pager
 import System.Information.X11DesktopInfo
@@ -60,9 +60,11 @@
 
 -- | Create a new LayoutSwitcher widget that will use the given Pager as
 -- its source of events.
-layoutSwitcherNew :: Pager -> IO Widget
+layoutSwitcherNew :: Pager -> IO Gtk.Widget
 layoutSwitcherNew pager = do
-  label <- labelNew (Nothing :: Maybe String)
+  label <- Gtk.labelNew (Nothing :: Maybe String)
+  -- This callback is run in a separate thread and needs to use
+  -- postGUIAsync
   let cfg = config pager
       callback = pagerCallback cfg label
   subscribe pager callback xLayoutProp
@@ -71,31 +73,31 @@
 -- | Build a suitable callback function that can be registered as Listener
 -- of "_XMONAD_CURRENT_LAYOUT" custom events. These events are emitted by
 -- the PagerHints hook to notify of changes in the current layout.
-pagerCallback :: PagerConfig -> Label -> Event -> IO ()
-pagerCallback cfg label _ = do
+pagerCallback :: PagerConfig -> Gtk.Label -> Event -> IO ()
+pagerCallback cfg label _ = Gtk.postGUIAsync $ do
   layout <- withDefaultCtx $ readAsString Nothing xLayoutProp
   let decorate = activeLayout cfg
-  postGUIAsync $ labelSetMarkup label (decorate layout)
+  Gtk.labelSetMarkup label (decorate layout)
 
 -- | Build the graphical representation of the widget.
-assembleWidget :: Label -> IO Widget
+assembleWidget :: Gtk.Label -> IO Gtk.Widget
 assembleWidget label = do
-  ebox <- eventBoxNew
-  containerAdd ebox label
-  _ <- on ebox buttonPressEvent dispatchButtonEvent
-  widgetShowAll ebox
-  return $ toWidget ebox
+  ebox <- Gtk.eventBoxNew
+  Gtk.containerAdd ebox label
+  _ <- Gtk.on ebox Gtk.buttonPressEvent dispatchButtonEvent
+  Gtk.widgetShowAll ebox
+  return $ Gtk.toWidget ebox
 
 -- | Call 'switch' with the appropriate argument (1 for left click, -1 for
 -- right click), depending on the click event received.
-dispatchButtonEvent :: EventM EButton Bool
+dispatchButtonEvent :: Gtk.EventM Gtk.EButton Bool
 dispatchButtonEvent = do
-  btn <- eventButton
-  let trigger = onClick [SingleClick]
+  btn <- Gtk.eventButton
+  let trigger = onClick [Gtk.SingleClick]
   case btn of
-    LeftButton  -> trigger $ switch 1
-    RightButton -> trigger $ switch (-1)
-    _           -> return False
+    Gtk.LeftButton  -> trigger $ switch 1
+    Gtk.RightButton -> trigger $ switch (-1)
+    _               -> return False
 
 -- | Emit a new custom event of type _XMONAD_CURRENT_LAYOUT, that can be
 -- intercepted by the PagerHints hook, which in turn can instruct XMonad to
diff --git a/src/System/Taffybar/MPRIS.hs b/src/System/Taffybar/MPRIS.hs
--- a/src/System/Taffybar/MPRIS.hs
+++ b/src/System/Taffybar/MPRIS.hs
@@ -5,10 +5,12 @@
 -- only works with version 1 of the MPRIS protocol
 -- (http://www.mpris.org/1.0/spec.html).  Support for version 2 will
 -- be in a separate widget.
---
--- This widget isn't as configurable as the others yet - that will be
--- fixed.
-module System.Taffybar.MPRIS ( mprisNew ) where
+module System.Taffybar.MPRIS
+  ( TrackInfo (..)
+  , MPRISConfig (..)
+  , defaultMPRISConfig
+  , mprisNew
+  ) where
 
 import Data.Int ( Int32 )
 import qualified Data.Map as M
@@ -19,8 +21,18 @@
 import Graphics.UI.Gtk hiding ( Signal, Variant )
 import Text.Printf
 
-setupDBus :: Label -> IO ()
-setupDBus w = do
+data TrackInfo = TrackInfo
+  { trackArtist :: Maybe String -- ^ Artist name, if available.
+  , trackTitle  :: Maybe String -- ^ Track name, if available.
+  , trackAlbum  :: Maybe String -- ^ Album name, if available.
+  }
+
+data MPRISConfig = MPRISConfig
+  { trackLabel :: TrackInfo -> String -- ^ Calculate a label to display.
+  }
+
+setupDBus :: MPRISConfig -> Label -> IO ()
+setupDBus cfg w = do
   let trackMatcher = matchAny { matchSender = Nothing
                                , matchDestination = Nothing
                                , matchPath = Just "/Player"
@@ -34,7 +46,7 @@
                                , matchMember = Just "StatusChange"
                                }
   client <- connectSession
-  listen client trackMatcher (trackCallback w)
+  listen client trackMatcher (trackCallback cfg w)
   listen client stateMatcher (stateCallback w)
 
 variantDictLookup :: (IsVariant b, Ord k) => k -> M.Map k Variant -> Maybe b
@@ -43,18 +55,19 @@
   fromVariant val
 
 
-trackCallback :: Label -> Signal -> IO ()
-trackCallback w s = do
+trackCallback :: MPRISConfig -> Label -> Signal -> IO ()
+trackCallback cfg w s = do
   let v :: Maybe (M.Map Text Variant)
       v = fromVariant variant
       [variant] = signalBody s
   case v of
     Just m -> do
-      let artist = maybe "[unknown]" id (variantDictLookup "artist" m)
-          track = maybe "[unknown]" id (variantDictLookup "title" m)
-          msg :: String
-          msg = escapeMarkup $ printf "%s - %s" (T.unpack artist) (T.unpack track)
-          txt = "<span fgcolor='yellow'>Now Playing:</span> " ++ msg
+      let getInfo key = fmap (escapeMarkup . T.unpack) $ variantDictLookup key m
+          txt = trackLabel cfg info
+          info = TrackInfo { trackArtist = getInfo "artist"
+                           , trackTitle  = getInfo "title"
+                           , trackAlbum  = getInfo "album"
+                           }
       postGUIAsync $ do
         -- In case the widget was hidden due to a stop/pause, forcibly
         -- show it again when the track changes.
@@ -74,10 +87,20 @@
       _ -> return ()
     _ -> return ()
 
-mprisNew :: IO Widget
-mprisNew = do
+defaultMPRISConfig :: MPRISConfig
+defaultMPRISConfig = MPRISConfig
+  { trackLabel = display
+  }
+  where artist track  = maybe "[unknown]" id (trackArtist track)
+        title  track  = maybe "[unknown]" id (trackTitle  track)
+        display :: TrackInfo -> String
+        display track = "<span fgcolor='yellow'>▶</span> " ++
+                        printf "%s - %s" (artist track) (title track)
+
+mprisNew :: MPRISConfig -> IO Widget
+mprisNew cfg = do
   l <- labelNew (Nothing :: Maybe String)
 
-  _ <- on l realize $ setupDBus l
+  _ <- on l realize $ setupDBus cfg l
   widgetShowAll l
   return (toWidget l)
diff --git a/src/System/Taffybar/MPRIS2.hs b/src/System/Taffybar/MPRIS2.hs
--- a/src/System/Taffybar/MPRIS2.hs
+++ b/src/System/Taffybar/MPRIS2.hs
@@ -75,14 +75,17 @@
 setSongInfo :: Label -> String -> String -> IO ()
 setSongInfo w artist title = do
   let msg :: String
-      msg = escapeMarkup $ printf "%s - %s" (cutoff 15 artist) (cutoff 30 title)
+      msg = case artist of
+        "" -> escapeMarkup $ printf "%s" (truncateString 30 title)
+        _ ->  escapeMarkup $ printf "%s - %s" (truncateString 15 artist) (truncateString 30 title)
       txt = "<span fgcolor='yellow'>▶</span> " ++ msg
   postGUIAsync $ do
     labelSetMarkup w txt
-    widgetShowAll w
-  where cutoff n xs | length xs <= n = xs
-                    | otherwise      = take n xs ++ "…"
 
+truncateString :: Int -> String -> String
+truncateString n xs | length xs <= n = xs
+              | otherwise      = take n xs ++ "…"
+
 updatePlaybackStatus :: Label -> [(Variant, Variant)] -> IO ()
 updatePlaybackStatus w items = do
   case lookup (toVariant ("PlaybackStatus" :: String)) items of
@@ -96,18 +99,23 @@
       return ()
 
 updateSongInfo :: Label -> [(Variant, Variant)] -> IO ()
-updateSongInfo w items =
-  case parseArtistAndTitle of
-    Just (artist, title) -> setSongInfo w artist title
+updateSongInfo w items = do
+  let artist = case readArtist of
+        Just x -> x
+        Nothing -> ""
+  case readTitle of
+    Just title -> do
+      setSongInfo w artist title
     Nothing -> return ()
   where
-    parseArtistAndTitle = do
-      aLookup <- lookup (toVariant ("xesam:artist" :: String)) items
-      tLookup <- lookup (toVariant ("xesam:title" :: String)) items
-      let artists = (unpack . unpack) aLookup :: [String]
-          title = (unpack . unpack) tLookup :: String
-      artist <- listToMaybe artists
-      return (artist, title)
+    readArtist :: Maybe String
+    readArtist = do
+      artist <- lookup (toVariant ("xesam:artist" :: String)) items
+      listToMaybe $ ((unpack . unpack) artist :: [String])
+    readTitle :: Maybe String
+    readTitle = do
+      title <- lookup (toVariant ("xesam:title" :: String)) items
+      Just $ (unpack . unpack) title
 
 updateMetadata :: Label -> [(Variant, Variant)] -> IO ()
 updateMetadata w items = do
diff --git a/src/System/Taffybar/NetMonitor.hs b/src/System/Taffybar/NetMonitor.hs
--- a/src/System/Taffybar/NetMonitor.hs
+++ b/src/System/Taffybar/NetMonitor.hs
@@ -64,7 +64,7 @@
       Just thisSample -> do
         lastSample <- readIORef sample
         writeIORef sample thisSample
-        let deltas = map fromIntegral $ zipWith (-) thisSample lastSample
+        let deltas = map (max 0 . fromIntegral) $ zipWith (-) thisSample lastSample
             speed@[incomingb, outgoingb] = map (/(interval)) deltas
             [incomingkb, outgoingkb] = map (setDigits prec . (/1024)) speed
             [incomingmb, outgoingmb] = map (setDigits prec . (/square 1024)) speed
diff --git a/src/System/Taffybar/SimpleClock.hs b/src/System/Taffybar/SimpleClock.hs
--- a/src/System/Taffybar/SimpleClock.hs
+++ b/src/System/Taffybar/SimpleClock.hs
@@ -16,7 +16,7 @@
 import Data.Time.Format
 import Data.Time.LocalTime
 import Graphics.UI.Gtk
-import System.Locale
+import qualified Data.Time.Locale.Compat as L
 
 import System.Taffybar.Widgets.PollingLabel
 import System.Taffybar.Widgets.Util
@@ -53,14 +53,14 @@
 -- | Create the widget.  I recommend passing @Nothing@ for the
 -- TimeLocale parameter.  The format string can include Pango markup
 -- (http://developer.gnome.org/pango/stable/PangoMarkupFormat.html).
-textClockNew :: Maybe TimeLocale -> String -> Double -> IO Widget
+textClockNew :: Maybe L.TimeLocale -> String -> Double -> IO Widget
 textClockNew userLocale fmt updateSeconds =
   textClockNewWith cfg fmt updateSeconds
   where
     cfg = defaultClockConfig { clockTimeLocale = userLocale }
 
 data ClockConfig = ClockConfig { clockTimeZone :: Maybe TimeZone
-                               , clockTimeLocale :: Maybe TimeLocale
+                               , clockTimeLocale :: Maybe L.TimeLocale
                                }
                                deriving (Eq, Ord, Show)
 
@@ -69,7 +69,7 @@
 defaultClockConfig = ClockConfig Nothing Nothing
 
 data TimeInfo = TimeInfo { getTZ :: IO TimeZone
-                         , getLocale :: IO TimeLocale
+                         , getLocale :: IO L.TimeLocale
                          }
 
 systemGetTZ :: IO TimeZone
@@ -94,7 +94,7 @@
 textClockNewWith :: ClockConfig -> String -> Double -> IO Widget
 textClockNewWith cfg fmt updateSeconds = do
   let ti = TimeInfo { getTZ = maybe systemGetTZ return userZone
-                    , getLocale = maybe (return defaultTimeLocale) return userLocale
+                    , getLocale = maybe (return L.defaultTimeLocale) return userLocale
                     }
   l    <- pollingLabelNew "" updateSeconds (getCurrentTime' ti fmt)
   ebox <- eventBoxNew
diff --git a/src/System/Taffybar/WindowSwitcher.hs b/src/System/Taffybar/WindowSwitcher.hs
--- a/src/System/Taffybar/WindowSwitcher.hs
+++ b/src/System/Taffybar/WindowSwitcher.hs
@@ -26,7 +26,8 @@
 ) where
 
 import Control.Monad (forM_)
-import Graphics.UI.Gtk
+import Control.Monad.IO.Class ( liftIO )
+import qualified Graphics.UI.Gtk as Gtk
 import Graphics.X11.Xlib.Extras (Event)
 import System.Information.EWMHDesktopInfo
 import System.Taffybar.Pager
@@ -53,10 +54,12 @@
 
 -- | Create a new WindowSwitcher widget that will use the given Pager as
 -- its source of events.
-windowSwitcherNew :: Pager -> IO Widget
+windowSwitcherNew :: Pager -> IO Gtk.Widget
 windowSwitcherNew pager = do
-  label <- labelNew (Nothing :: Maybe String)
-  widgetSetName label "label"
+  label <- Gtk.labelNew (Nothing :: Maybe String)
+  Gtk.widgetSetName label "label"
+  -- This callback is registered through 'subscribe', which runs the
+  -- callback in another thread.  We need to use postGUIAsync in it.
   let cfg = config pager
       callback = pagerCallback cfg label
   subscribe pager callback "_NET_ACTIVE_WINDOW"
@@ -65,24 +68,24 @@
 -- | Build a suitable callback function that can be registered as Listener
 -- of "_NET_ACTIVE_WINDOW" standard events. It will keep track of the
 -- currently focused window.
-pagerCallback :: PagerConfig -> Label -> Event -> IO ()
+pagerCallback :: PagerConfig -> Gtk.Label -> Event -> IO ()
 pagerCallback cfg label _ = do
   title <- withDefaultCtx getActiveWindowTitle
   let decorate = activeWindow cfg
-  postGUIAsync $ labelSetMarkup label (decorate $ nonEmpty title)
+  Gtk.postGUIAsync $ Gtk.labelSetMarkup label (decorate $ nonEmpty title)
 
 -- | Build the graphical representation of the widget.
-assembleWidget :: Label -> IO Widget
+assembleWidget :: Gtk.Label -> IO Gtk.Widget
 assembleWidget label = do
-  title <- menuItemNew
-  widgetSetName title "title"
-  containerAdd title label
+  title <- Gtk.menuItemNew
+  Gtk.widgetSetName title "title"
+  Gtk.containerAdd title label
 
-  switcher <- menuBarNew
-  widgetSetName switcher "WindowSwitcher"
-  containerAdd switcher title
+  switcher <- Gtk.menuBarNew
+  Gtk.widgetSetName switcher "WindowSwitcher"
+  Gtk.containerAdd switcher title
 
-  rcParseString $ unlines [ "style 'WindowSwitcher' {"
+  Gtk.rcParseString $ unlines [ "style 'WindowSwitcher' {"
                           , "  xthickness = 0"
                           , "  GtkMenuBar::internal-padding = 0"
                           , "}"
@@ -93,35 +96,39 @@
                           , "widget '*WindowSwitcher' style 'WindowSwitcher'"
                           , "widget '*WindowSwitcher*title' style 'title'"
                           ]
-  menu <- menuNew
-  widgetSetName menu "menu"
+  menu <- Gtk.menuNew
+  Gtk.widgetSetName menu "menu"
 
-  menuTop <- widgetGetToplevel menu
-  widgetSetName menuTop "Taffybar_WindowSwitcher"
+  menuTop <- Gtk.widgetGetToplevel menu
+  Gtk.widgetSetName menuTop "Taffybar_WindowSwitcher"
 
-  menuItemSetSubmenu title menu
-  _ <- on title menuItemActivate $ fillMenu  menu
-  _ <- on title menuItemDeselect $ emptyMenu menu
+  Gtk.menuItemSetSubmenu title menu
+  -- These callbacks are run in the GUI thread automatically and do
+  -- not need to use postGUIAsync
+  _ <- Gtk.on title Gtk.menuItemActivate $ fillMenu  menu
+  _ <- Gtk.on title Gtk.menuItemDeselect $ emptyMenu menu
 
-  widgetShowAll switcher
-  return $ toWidget switcher
+  Gtk.widgetShowAll switcher
+  return $ Gtk.toWidget switcher
 
 -- | Populate the given menu widget with the list of all currently open windows.
-fillMenu :: MenuClass menu => menu -> IO ()
-fillMenu menu = do
-  handles  <- withDefaultCtx getWindowHandles
+fillMenu :: Gtk.MenuClass menu => menu -> IO ()
+fillMenu menu = withDefaultCtx $ do
+  handles <- getWindowHandles
   if null handles then return () else do
-    wsNames  <- withDefaultCtx getWorkspaceNames
-    forM_ handles $ \handle -> do
-      item <- menuItemNewWithLabel (formatEntry wsNames handle)
-      _ <- onActivateLeaf item $ withDefaultCtx (focusWindow $ snd handle)
-      menuShellAppend menu item
-      widgetShow item
+    wsNames <- getWorkspaceNames
+    forM_ handles $ \handle -> liftIO $ do
+      item <- Gtk.menuItemNewWithLabel (formatEntry wsNames handle)
+      _ <- Gtk.on item Gtk.buttonPressEvent $ liftIO $ do
+        withDefaultCtx (focusWindow $ snd handle)
+        return True
+      Gtk.menuShellAppend menu item
+      Gtk.widgetShow item
 
 -- | Remove all contents from the given menu widget.
-emptyMenu :: MenuClass menu => menu -> IO ()
-emptyMenu menu = containerForeach menu $ \item ->
-                 containerRemove menu item >> postGUIAsync (widgetDestroy item)
+emptyMenu :: Gtk.MenuClass menu => menu -> IO ()
+emptyMenu menu = Gtk.containerForeach menu $ \item ->
+                 Gtk.containerRemove menu item >> Gtk.widgetDestroy item
 
 -- | Build the name to display in the list of windows by prepending the name
 -- of the workspace it is currently in to the name of the window itself
diff --git a/src/System/Taffybar/WorkspaceSwitcher.hs b/src/System/Taffybar/WorkspaceSwitcher.hs
--- a/src/System/Taffybar/WorkspaceSwitcher.hs
+++ b/src/System/Taffybar/WorkspaceSwitcher.hs
@@ -26,18 +26,18 @@
   wspaceSwitcherNew
 ) where
 
+import qualified Control.Concurrent.MVar as MV
 import Control.Monad
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Data.IORef
 import Data.List ((\\), findIndices)
-import Graphics.UI.Gtk hiding (get)
+import qualified Graphics.UI.Gtk as Gtk
 import Graphics.X11.Xlib.Extras
 
 import System.Taffybar.Pager
 import System.Information.EWMHDesktopInfo
 
 type Desktop = [Workspace]
-data Workspace = Workspace { label  :: Label
+data Workspace = Workspace { label  :: Gtk.Label
                            , name   :: String
                            , urgent :: Bool
                            }
@@ -77,13 +77,15 @@
 
 -- | Create a new WorkspaceSwitcher widget that will use the given Pager as
 -- its source of events.
-wspaceSwitcherNew :: Pager -> IO Widget
+wspaceSwitcherNew :: Pager -> IO Gtk.Widget
 wspaceSwitcherNew pager = do
-  switcher <- hBoxNew False 0
+  switcher <- Gtk.hBoxNew False 0
   desktop  <- getDesktop pager
-  deskRef  <- newIORef desktop
+  deskRef  <- MV.newMVar desktop
   populateSwitcher switcher deskRef
 
+  -- These callbacks need to use postGUIAsync since they run in
+  -- another thread
   let cfg = config pager
       activecb = activeCallback cfg deskRef
       redrawcb = redrawCallback pager deskRef switcher
@@ -92,7 +94,7 @@
   subscribe pager redrawcb "_NET_NUMBER_OF_DESKTOPS"
   subscribe pager urgentcb "WM_HINTS"
 
-  return $ toWidget switcher
+  return $ Gtk.toWidget switcher
 
 -- | List of indices of all available workspaces.
 allWorkspaces :: Desktop -> [Int]
@@ -114,42 +116,46 @@
 -- | Take an existing Desktop IORef and update it if necessary, store the result
 -- in the IORef, then return True if the reference was actually updated, False
 -- otherwise.
-updateDesktop :: Pager -> IORef Desktop -> IO Bool
+updateDesktop :: Pager -> MV.MVar Desktop -> IO Bool
 updateDesktop pager deskRef = do
   wsnames <- withDefaultCtx getWorkspaceNames
-  desktop <- readIORef deskRef
-  if (length wsnames /= length desktop)
-  then getDesktop pager >>= writeIORef deskRef >> return True
-  else return False
+  MV.modifyMVar deskRef $ \desktop ->
+    case length wsnames /= length desktop of
+      True -> do
+        desk' <- getDesktop pager
+        return (desk', True)
+      False -> return (desktop, False)
 
 -- | Clean up the given box, then fill it up with the buttons for the current
 -- state of the desktop.
-populateSwitcher :: BoxClass box => box -> IORef Desktop -> IO ()
+populateSwitcher :: Gtk.BoxClass box => box -> MV.MVar Desktop -> IO ()
 populateSwitcher switcher deskRef = do
   containerClear switcher
-  desktop <- readIORef deskRef
+  desktop <- MV.readMVar deskRef
   mapM_ (addButton switcher desktop) (allWorkspaces desktop)
-  widgetShowAll switcher
+  Gtk.widgetShowAll switcher
 
 -- | Build a suitable callback function that can be registered as Listener
 -- of "_NET_CURRENT_DESKTOP" standard events. It will track the position of
 -- the active workspace in the desktop.
-activeCallback :: PagerConfig -> IORef Desktop -> Event -> IO ()
-activeCallback cfg deskRef _ = do
+activeCallback :: PagerConfig -> MV.MVar Desktop -> Event -> IO ()
+activeCallback cfg deskRef _ = Gtk.postGUIAsync $ do
   curr <- withDefaultCtx getVisibleWorkspaces
-  desktop <- readIORef deskRef
-  let visible = head curr
-  when (urgent $ desktop !! visible) $
-    liftIO $ toggleUrgent deskRef visible False
-  transition cfg desktop curr
+  desktop <- MV.readMVar deskRef
+  case curr of
+    visible : _ | length desktop > visible -> do
+      when (urgent (desktop !! visible)) $ do
+        toggleUrgent deskRef visible False
+      transition cfg desktop curr
+    _ -> return ()
 
 -- | Build a suitable callback function that can be registered as Listener
 -- of "WM_HINTS" standard events. It will display in a different color any
 -- workspace (other than the active one) containing one or more windows
 -- with its urgency hint set.
-urgentCallback :: PagerConfig -> IORef Desktop -> Event -> IO ()
-urgentCallback cfg deskRef event = do
-  desktop <- readIORef deskRef
+urgentCallback :: PagerConfig -> MV.MVar Desktop -> Event -> IO ()
+urgentCallback cfg deskRef event = Gtk.postGUIAsync $ do
+  desktop <- MV.readMVar deskRef
   withDefaultCtx $ do
     let window = ev_window event
     isUrgent <- isWindowUrgent window
@@ -163,39 +169,43 @@
 -- | Build a suitable callback function that can be registered as Listener
 -- of "_NET_NUMBER_OF_DESKTOPS" standard events. It will handle dynamically
 -- adding and removing workspaces.
-redrawCallback :: BoxClass box => Pager -> IORef Desktop -> box -> Event -> IO ()
-redrawCallback pager deskRef box _ =
-  updateDesktop pager deskRef >>= \deskChanged ->
-    when deskChanged $ postGUIAsync (populateSwitcher box deskRef)
+redrawCallback :: Gtk.BoxClass box => Pager -> MV.MVar Desktop -> box -> Event -> IO ()
+redrawCallback pager deskRef box _ = Gtk.postGUIAsync $ do
+  -- updateDesktop indirectly invokes some gtk functions, so it also
+  -- needs to be guarded by postGUIAsync
+  deskChanged <- updateDesktop pager deskRef
+  when deskChanged $ populateSwitcher box deskRef
 
 -- | Remove all children of a container.
-containerClear :: ContainerClass self => self -> IO ()
-containerClear container = containerForeach container (containerRemove container)
+containerClear :: Gtk.ContainerClass self => self -> IO ()
+containerClear container = Gtk.containerForeach container (Gtk.containerRemove container)
 
 -- | Convert the given list of Strings to a list of Label widgets.
-toLabels :: [String] -> IO [Label]
+toLabels :: [String] -> IO [Gtk.Label]
 toLabels = mapM labelNewMarkup
   where labelNewMarkup markup = do
-          lbl <- labelNew (Nothing :: Maybe String)
-          labelSetMarkup lbl markup
+          lbl <- Gtk.labelNew (Nothing :: Maybe String)
+          Gtk.labelSetMarkup lbl markup
           return lbl
 
 -- | Build a new clickable event box containing the Label widget that
 -- corresponds to the given index, and add it to the given container.
-addButton :: BoxClass self
+addButton :: Gtk.BoxClass self
           => self    -- ^ Graphical container.
           -> Desktop -- ^ List of all workspace Labels available.
           -> Int     -- ^ Index of the workspace to use.
           -> IO ()
-addButton hbox desktop idx = do
-  let index = desktop !! idx
-      lbl = label index
-  ebox <- eventBoxNew
-  widgetSetName ebox $ name index
-  eventBoxSetVisibleWindow ebox False
-  _ <- on ebox buttonPressEvent $ switch idx
-  containerAdd ebox lbl
-  boxPackStart hbox ebox PackNatural 0
+addButton hbox desktop idx
+  | length desktop > idx = do
+    let index = desktop !! idx
+        lbl = label index
+    ebox <- Gtk.eventBoxNew
+    Gtk.widgetSetName ebox $ name index
+    Gtk.eventBoxSetVisibleWindow ebox False
+    _ <- Gtk.on ebox Gtk.buttonPressEvent $ switch idx
+    Gtk.containerAdd ebox lbl
+    Gtk.boxPackStart hbox ebox Gtk.PackNatural 0
+  | otherwise = return ()
 
 -- | Re-mark all workspace labels.
 transition :: PagerConfig -- ^ Configuration settings.
@@ -209,8 +219,11 @@
       nonEmptyWs = nonEmpty \\ urgentWs
   mapM_ (mark desktop $ hiddenWorkspace cfg) nonEmptyWs
   mapM_ (mark desktop $ emptyWorkspace cfg) (allWs \\ nonEmpty)
-  mark desktop (activeWorkspace cfg) (head wss)
-  mapM_ (mark desktop $ visibleWorkspace cfg) (tail wss)
+  case wss of
+    active:rest -> do
+      mark desktop (activeWorkspace cfg) active
+      mapM_ (mark desktop $ visibleWorkspace cfg) rest
+    _ -> return ()
   mapM_ (mark desktop $ urgentWorkspace cfg) urgentWs
 
 -- | Apply the given marking function to the Label of the workspace with
@@ -219,9 +232,11 @@
      -> (String -> String) -- ^ Marking function.
      -> Int                -- ^ Index of the Label to modify.
      -> IO ()
-mark desktop decorate idx = do
-  let ws = desktop !! idx
-  postGUIAsync $ labelSetMarkup (label ws) $ decorate' (name ws)
+mark desktop decorate idx
+  | length desktop > idx = do
+    let ws = desktop !! idx
+    Gtk.postGUIAsync $ Gtk.labelSetMarkup (label ws) $ decorate' (name ws)
+  | otherwise = return ()
   where decorate' = pad . decorate
         pad m | m == [] = m
               | otherwise = ' ' : m
@@ -234,14 +249,19 @@
 
 -- | Modify the Desktop inside the given IORef, so that the Workspace at the
 -- given index has its "urgent" flag set to the given value.
-toggleUrgent :: IORef Desktop -- ^ IORef to modify.
+toggleUrgent :: MV.MVar Desktop -- ^ IORef to modify.
              -> Int           -- ^ Index of the Workspace to replace.
              -> Bool          -- ^ New value of the "urgent" flag.
              -> IO ()
-toggleUrgent deskRef idx isUrgent = do
-  desktop <- readIORef deskRef
-  let ws = desktop !! idx
-  unless (isUrgent == urgent ws) $ do
-    let ws' = (desktop !! idx) { urgent = isUrgent }
-    let (ys, zs) = splitAt idx desktop
-        in writeIORef deskRef $ ys ++ (ws' : tail zs)
+toggleUrgent deskRef idx isUrgent =
+  MV.modifyMVar_ deskRef $ \desktop -> do
+    let ws = desktop !! idx
+    case length desktop > idx of
+      True | isUrgent /= urgent ws -> do
+               let ws' = ws { urgent = isUrgent }
+                   (ys, zs) = splitAt idx desktop
+               case zs of
+                 _ : rest -> return $ ys ++ (ws' : rest)
+                 _ -> return (ys ++ [ws'])
+      _ -> return desktop
+
diff --git a/taffybar.cabal b/taffybar.cabal
--- a/taffybar.cabal
+++ b/taffybar.cabal
@@ -1,5 +1,5 @@
 name: taffybar
-version: 0.4.4
+version: 0.4.5
 synopsis: A desktop bar similar to xmobar, but with more GUI
 license: BSD3
 license-file: LICENSE
@@ -26,7 +26,8 @@
 library
   default-language: Haskell2010
   build-depends: base > 3 && < 5,
-                 time >= 1.4 && < 1.5,
+                 time >= 1.4 && < 1.6,
+                 time-locale-compat >= 0.1 && < 0.2,
                  old-locale,
                  containers,
                  text,