Merge pull request #96 from maoe/optional-logo

Make the app work even if it fails to load the logo (fixes #95)

Author: maoe

GUI/App.hs

@@ -28,7 +28,7 @@ initApp = do
   menuBar <- Gtk.menuBarNew
   OSX.applicationSetMenuBar app menuBar
   logo <- $loadLogo
-  OSX.applicationSetDockIconPixbuf app (Just logo)
+  OSX.applicationSetDockIconPixbuf app logo
   OSX.applicationReady app
 
 #else

GUI/DataFiles.hs

@@ -1,13 +1,16 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 module GUI.DataFiles
   ( ui
   , loadLogo
   ) where
+import Control.Exception (IOException, Handler(..), catches)
 import System.IO
 
 import Data.FileEmbed
 import Graphics.UI.Gtk (Pixbuf, pixbufNewFromFile)
 import Language.Haskell.TH
+import System.Glib (GError)
 import System.IO.Temp
 import qualified Data.ByteString as B
 import qualified Data.Text.Encoding as TE
@@ -22,12 +25,17 @@ logoFile = "threadscope.png"
 ui :: Q Exp
 ui = [| TE.decodeUtf8 $(makeRelativeToProject uiFile >>= embedFile) |]
 
-renderLogo :: B.ByteString -> IO Pixbuf
+renderLogo :: B.ByteString -> IO (Maybe Pixbuf)
 renderLogo bytes =
   withSystemTempFile logoFile $ \path h -> do
     B.hPut h bytes
     hClose h
-    pixbufNewFromFile path
+    Just <$> pixbufNewFromFile path
+  `catches`
+    -- in case of a failure in the file IO or pixbufNewFromFile, return Nothing
+    [ Handler $ \(_ :: IOException) -> return Nothing
+    , Handler $ \(_ :: GError) -> return Nothing
+    ]
 
 -- | Load the logo file as a 'Pixbuf'.
 loadLogo :: Q Exp

GUI/Dialogs.hs

@@ -28,7 +28,7 @@ aboutDialog parent
                                   "Mikolaj Konarski <mikolaj@well-typed.com>",
                                   "Nicolas Wu <nick@well-typed.com>",
                                   "Eric Kow <eric@well-typed.com>"],
-         aboutDialogLogo      := Just logo,
+         aboutDialogLogo      := logo,
          aboutDialogWebsite   := "http://www.haskell.org/haskellwiki/ThreadScope",
          windowTransientFor   := toWindow parent
         ]

GUI/MainWindow.hs

@@ -141,7 +141,7 @@ mainWindowNew builder actions = do
   ------------------------------------------------------------------------
 
   logo <- $loadLogo
-  set mainWindow [ windowIcon := Just logo ]
+  set mainWindow [ windowIcon := logo ]
 
   ------------------------------------------------------------------------
   -- Status bar functionality