From 7cf24a418791bd698e4fa4de531890ff0256d85e Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 7 Jan 2020 13:16:42 +0100
Subject: [PATCH] refactor: avoid recompilation due to static files

---
 src/Foundation.hs                   | 15 ++-------------
 src/Settings/StaticFiles/Webpack.hs | 23 ++++++++++++++++++++++-
 2 files changed, 24 insertions(+), 14 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index e8923b226..1e8f535bc 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1574,20 +1574,9 @@ siteLayout' headingOverride widget = do
   frontendDatetimeLocale <- toJSON <$> selectLanguage frontendDatetimeLocales
 
   pc <- widgetToPageContent $ do
-      $logDebugS "siteLayout" $ tshow webpackEntrypoint_main
-      forM_ webpackEntrypoint_main $ \(sRoute, mime) ->
-        let ctEq = (==) `on` simpleContentType
-         in if
-              | mime `ctEq` "text/css"
-                -> addStylesheet $ StaticR sRoute
-              | mime `ctEq` "application/javascript"
-                -> addScript $ StaticR sRoute
-              | otherwise
-                -> $logErrorS "siteLayout" [st|Unknown mime type in webpack bundle: #{tshow mime}|]
-
-      toWidget $(juliusFile "templates/i18n.julius")
-
+      webpackLinks_main StaticR
       faviconLinks
+      toWidget $(juliusFile "templates/i18n.julius")
 
       $(widgetFile "default-layout")
   withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
diff --git a/src/Settings/StaticFiles/Webpack.hs b/src/Settings/StaticFiles/Webpack.hs
index 81320818d..3fcd6c224 100644
--- a/src/Settings/StaticFiles/Webpack.hs
+++ b/src/Settings/StaticFiles/Webpack.hs
@@ -12,7 +12,7 @@ import qualified Data.Yaml as Yaml
 
 import qualified Data.Map as Map
 
-import Yesod.Core (Route)
+import Yesod.Core (Route, MonadLogger, MonadWidget, HandlerSite, logDebugS, logErrorS)
 import Yesod.EmbeddedStatic (EmbeddedStatic)
 import Yesod.EmbeddedStatic.Types
 import Network.Mime (MimeType)
@@ -27,6 +27,8 @@ import Utils (nubOn)
 
 import System.FilePath (makeRelative)
 
+import Text.Shakespeare.Text (st)
+
 
 mkWebpackEntrypoints :: FilePath -- ^ Path to YAML-manifest
                      -> [FilePath -> Generator]
@@ -54,11 +56,30 @@ mkWebpackEntrypoints manifest mkGen stDir = do
         Just n -> tell $ pure (n, ebMimeType entry)
     
     let entryName = mkName $ "webpackEntrypoint_" <> entrypoint
+        widgetName = mkName $ "webpackLinks_" <> entrypoint
+
+    staticR <- newName "staticR" 
     sequence
       [ sigD entryName [t|[(Route EmbeddedStatic, MimeType)]|]
       , funD entryName
           [ clause [] (normalB . listE . map (\(n, mime) -> tupE [varE n, TH.lift mime]) $ nubOn fst entries) []
           ]
+      , sigD widgetName [t|forall m. (MonadLogger m, MonadWidget m) => (Route EmbeddedStatic -> Route (HandlerSite m)) -> m ()|]
+      , funD widgetName
+          [ clause [varP staticR] (normalB [e|
+              do
+                $logDebugS "siteLayout" $ tshow $(varE entryName)
+                forM_ $(varE entryName) $ \(sRoute, mime) ->
+                  let ctEq = (==) `on` simpleContentType
+                   in if
+                        | mime `ctEq` "text/css"
+                          -> addStylesheet $ $(varE staticR) sRoute
+                        | mime `ctEq` "application/javascript"
+                          -> addScript $ $(varE staticR) sRoute
+                        | otherwise
+                          -> $logErrorS "siteLayout" [st|Unknown mime type in webpack bundle: #{tshow mime}|]
+            |]) []
+          ]
       ]
   where
     decodeManifest :: FilePath -> Q (Map String [FilePath])