Annotate widget files in dev-mode

src/Settings.hs

@@ -21,12 +21,14 @@ import           Data.Aeson.TH
 import           Data.FileEmbed              (embedFile)
 import           Data.Yaml                   (decodeEither')
 import           Database.Persist.Postgresql (PostgresConf)
-import           Language.Haskell.TH.Syntax  (Exp, Name, Q)
+import           Language.Haskell.TH.Syntax  (Exp, Q, location, Loc(..))
 import           Network.Wai.Handler.Warp    (HostPreference)
 import           Yesod.Default.Config2       (applyEnvValue, configSettingsYml)
-import           Yesod.Default.Util          (WidgetFileSettings,
+#ifdef DEVELOPMENT
-                                              widgetFileNoReload,
+import           Yesod.Default.Util          (WidgetFileSettings, widgetFileReload)
-                                              widgetFileReload)
+#else
+import           Yesod.Default.Util          (WidgetFileSettings, widgetFileNoReload, widgetFileReload)
+#endif
 import qualified Yesod.Auth.Util.PasswordStore as PWStore
 
 import Data.Time (NominalDiffTime, nominalDay)
@@ -65,6 +67,9 @@ import qualified System.FilePath as FilePath
 
 import Jose.Jwt (JwtEncoding(..))
 
+import Text.Shakespeare.Text (st)
+import Text.Blaze.Html (preEscapedToHtml)
+
 
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
@@ -409,18 +414,31 @@ makeClassy_ ''AppSettings
 widgetFileSettings :: WidgetFileSettings
 widgetFileSettings = def
 
--- | How static files should be combined.
-combineSettings :: CombineSettings
-combineSettings = def
-
 -- The rest of this file contains settings which rarely need changing by a
 -- user.
 
 widgetFile :: String -> Q Exp
-widgetFile = (if appReloadTemplates compileTimeAppSettings
+#ifdef DEVELOPMENT
-                then widgetFileReload
+widgetFile nameBase = do
-                else widgetFileNoReload)
+  Loc{..} <- location
-              widgetFileSettings
+  let nameBase' = "templates" </> nameBase
+      before, after :: Text
+      before = [st|<!-- BEGIN ‘#{nameBase'}.*’ IN ‘#{loc_filename}’ #{tshow loc_start}–#{tshow loc_end} -->|]
+      after  = [st|<!-- END ‘#{nameBase'}.*’ -->|]
+  [e| do
+        toWidget $ preEscapedToHtml before
+        $(widgetFileReload widgetFileSettings nameBase)
+        toWidget $ preEscapedToHtml after
+    |]
+#else
+widgetFile nameBase = do
+  let widgetFile
+        | appReloadTemplates compileTimeAppSettings
+        = widgetFileReload widgetFileSettings
+        | otherwise
+        = widgetFileNoReload widgetFileSettings
+  [e| widgetFile nameBase |]
+#endif
 
 -- | Raw bytes at compile time of @config/settings.yml@
 configSettingsYmlBS :: ByteString
@@ -437,19 +455,3 @@ compileTimeAppSettings =
     case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of
         Error e -> error e
         Success settings -> settings
-
--- The following two functions can be used to combine multiple CSS or JS files
--- at compile time to decrease the number of http requests.
--- Sample usage (inside a Widget):
---
--- > $(combineStylesheets 'StaticR [style1_css, style2_css])
-
-combineStylesheets :: Name -> [Route Static] -> Q Exp
-combineStylesheets = combineStylesheets'
-    (appSkipCombining compileTimeAppSettings)
-    combineSettings
-
-combineScripts :: Name -> [Route Static] -> Q Exp
-combineScripts = combineScripts'
-    (appSkipCombining compileTimeAppSettings)
-    combineSettings