From 6cf291b02e373b23db8ea2ef45cef5a365211e26 Mon Sep 17 00:00:00 2001
From: Heinrich Apfelmus <apfelmus@quantentunnel.de>
Date: Sat, 26 Aug 2017 19:33:39 +0200
Subject: [PATCH] Use file-embed package to load resources. #148

The use of `makeRelativeToProject` might make the
library easier to install with stack in some cases.

Do not use QuasiQuotes, but ordinary TemplateHaskell.
---
 src/Foreign/JavaScript/Include.hs   | 31 +++++++----------------------
 src/Foreign/JavaScript/Resources.hs | 25 ++++++++++++-----------
 threepenny-gui.cabal                |  1 +
 3 files changed, 21 insertions(+), 36 deletions(-)

diff --git a/src/Foreign/JavaScript/Include.hs b/src/Foreign/JavaScript/Include.hs
index 66fe2454..f92aa058 100644
--- a/src/Foreign/JavaScript/Include.hs
+++ b/src/Foreign/JavaScript/Include.hs
@@ -2,34 +2,17 @@
 module Foreign.JavaScript.Include (include) where
 
 import           Data.Functor
-import qualified Language.Haskell.TH       as TH
-import           Language.Haskell.TH.Quote
+import           Data.FileEmbed      (makeRelativeToProject)
+import           Language.Haskell.TH
 import           System.IO
-import           System.Environment(lookupEnv)
-import           Data.Maybe (fromMaybe)
 
-
-#if defined(SAMPLES)
-root :: FilePath
-root = ".." -- we are running the examples from ghci
-#else
-root :: FilePath
-root = "."
-#endif
-
-include :: QuasiQuoter
-include = QuasiQuoter
-        { quoteExp  = f             -- only used as an expression,
-        , quotePat  = undefined     -- hence all other use cases undefined
-        , quoteType = undefined
-        , quoteDec  = undefined
-        }
-    where
-    f s = TH.LitE . TH.StringL <$> TH.runIO (readFileUTF8 s)
+include :: FilePath -> Q Exp
+include path = do
+    path <- makeRelativeToProject path
+    LitE . StringL <$> runIO (readFileUTF8 path)
 
 readFileUTF8 :: FilePath -> IO String
 readFileUTF8 path = do
-    env <- lookupEnv "THREEPENNY_ROOT"
-    h <- openFile (fromMaybe root env ++ "/" ++ path) ReadMode
+    h <- openFile path ReadMode
     hSetEncoding h utf8
     hGetContents h
diff --git a/src/Foreign/JavaScript/Resources.hs b/src/Foreign/JavaScript/Resources.hs
index 09796e1e..22f2b799 100644
--- a/src/Foreign/JavaScript/Resources.hs
+++ b/src/Foreign/JavaScript/Resources.hs
@@ -1,23 +1,24 @@
-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
 module Foreign.JavaScript.Resources where
 
 import           Data.Text                          (Text)
 import qualified Data.Text                  as Text
 import           Foreign.JavaScript.Include
 
-jsDriverCode :: Maybe String -> Text
-jsDriverCode dict = Text.unlines $ map Text.pack
-    [ [include|js/lib/jquery.js|]
-    , [include|js/lib/jquery-cookie.js|]
-    , "var Haskell = { };" ++ maybe "" (\dict -> "dict = \""++ dict++ "\";") dict
-    , [include|js/comm.js|]
-    , [include|js/ffi.js|]
-    , [include|js/lib.js|]
-    , [include|js/log.js|]
+
+jsDriverCode :: Text
+jsDriverCode = Text.unlines $ map Text.pack
+    [ $(include "js/lib/jquery.js")
+    , $(include "js/lib/jquery-cookie.js")
+    , "var Haskell = {};" ++ maybe "" (\dict -> "dict = \""++ dict++ "\";") dict
+    , $(include "js/comm.js")
+    , $(include "js/ffi.js")
+    , $(include "js/lib.js")
+    , $(include "js/log.js")
     ]
 
 cssDriverCode :: Text
-cssDriverCode = Text.pack [include|js/haskell.css|]
+cssDriverCode = Text.pack $(include "js/haskell.css")
 
 defaultHtmlFile :: Text
-defaultHtmlFile = Text.pack [include|js/index.html|]
+defaultHtmlFile = Text.pack $(include "js/index.html")
diff --git a/threepenny-gui.cabal b/threepenny-gui.cabal
index 14ce7683..635c1606 100644
--- a/threepenny-gui.cabal
+++ b/threepenny-gui.cabal
@@ -115,6 +115,7 @@ Library
                     ,deepseq                >= 1.3.0 && < 1.5
                     ,exceptions             >= 0.6   && < 0.9
                     ,filepath               >= 1.3.0 && < 1.5.0
+                    ,file-embed             == 0.0.10
                     ,hashable               >= 1.1.0 && < 1.3
                     ,safe                   == 0.3.*
                     ,snap-server            >= 0.9.0 && < 1.1