Embed data files into binary for easier deployment

Author: Mitsutoshi Aoe

GUI/DataFiles.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE TemplateHaskell #-}
+module GUI.DataFiles
+  ( ui
+  , loadLogo
+  ) where
+import System.IO
+
+import Data.FileEmbed
+import Graphics.UI.Gtk (Pixbuf, pixbufNewFromFile)
+import Language.Haskell.TH
+import System.IO.Temp
+import qualified Data.ByteString as B
+import qualified Data.Text.Encoding as TE
+
+uiFile :: FilePath
+uiFile = "threadscope.ui"
+
+logoFile :: FilePath
+logoFile = "threadscope.png"
+
+-- | Textual representaion of the UI file
+ui :: Q Exp
+ui = [| TE.decodeUtf8 $(makeRelativeToProject uiFile >>= embedFile) |]
+
+renderLogo :: B.ByteString -> IO Pixbuf
+renderLogo bytes =
+  withSystemTempFile logoFile $ \path h -> do
+    B.hPut h bytes
+    hClose h
+    pixbufNewFromFile path
+
+-- | Load the logo file as a 'Pixbuf'.
+loadLogo :: Q Exp
+loadLogo = [| renderLogo $(makeRelativeToProject logoFile >>= embedFile) |]

GUI/Dialogs.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
 module GUI.Dialogs where
 
-import Paths_threadscope (getDataFileName, version)
+import GUI.DataFiles (loadLogo)
+import Paths_threadscope (version)
 
 import Graphics.UI.Gtk
 
@@ -13,8 +15,7 @@ import System.FilePath
 aboutDialog :: WindowClass window => window -> IO ()
 aboutDialog parent
  = do dialog <- aboutDialogNew
-      logoPath <- getDataFileName "threadscope.png"
-      logo <- pixbufNewFromFile logoPath
+      logo <- $loadLogo
       set dialog [
          aboutDialogName      := "ThreadScope",
          aboutDialogVersion   := showVersion version,

GUI/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
 module GUI.Main (runGUI) where
 
 -- Imports for GTK
@@ -16,13 +17,12 @@ import Control.Exception
 import Data.Array
 import Data.Maybe
 
-import Paths_threadscope
-
 -- Imports for ThreadScope
 import qualified GUI.App as App
 import qualified GUI.MainWindow as MainWindow
 import GUI.Types
 import Events.HECs hiding (Event)
+import GUI.DataFiles (ui)
 import GUI.Dialogs
 import Events.ReadEvents
 import GUI.EventsView
@@ -117,7 +117,7 @@ constructUI :: IO UIEnv
 constructUI = failOnGError $ do
 
   builder <- Gtk.builderNew
-  Gtk.builderAddFromFile builder =<< getDataFileName "threadscope.ui"
+  Gtk.builderAddFromString builder $ui
 
   eventQueue <- Chan.newChan
   let post = postEvent eventQueue

GUI/MainWindow.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
 module GUI.MainWindow (
     MainWindow,
     mainWindowNew,
@@ -10,12 +11,10 @@ module GUI.MainWindow (
 
   ) where
 
-import Paths_threadscope
-
--- Imports for GTK
 import Graphics.UI.Gtk as Gtk
 import qualified System.Glib.GObject as Glib
 
+import GUI.DataFiles (loadLogo)
 
 -------------------------------------------------------------------------------
 
@@ -146,8 +145,8 @@ mainWindowNew builder actions = do
 
   ------------------------------------------------------------------------
 
-  logoPath <- getDataFileName "threadscope.png"
-  windowSetIconFromFile mainWindow logoPath
+  logo <- $loadLogo
+  set mainWindow [ windowIcon := Just logo ]
 
   ------------------------------------------------------------------------
   -- Status bar functionality

threadscope.cabal

@@ -58,7 +58,11 @@ Executable threadscope
                      containers >= 0.2 && < 0.6,
                      deepseq >= 1.1,
                      text < 1.3,
-                     time >= 1.1 && < 1.9
+                     time >= 1.1 && < 1.9,
+                     bytestring < 0.11,
+                     file-embed < 0.1,
+                     template-haskell < 2.13,
+                     temporary >= 1.1 && < 1.3
   if os(osx)
     build-depends:   gtk-mac-integration
 
@@ -74,6 +78,7 @@ Executable threadscope
                      GUI.Main,
                      GUI.MainWindow,
                      GUI.EventsView,
+                     GUI.DataFiles,
                      GUI.Dialogs,
                      GUI.SaveAs,
                      GUI.Timeline,