Allow sitewide hamlet changes (#377)

yesod-core/Yesod/Widget.hs

@@ -53,6 +53,7 @@ module Yesod.Widget
     , addScriptEither
       -- * Internal
     , unGWidget
+    , whamletFileWithSettings
     ) where
 
 import Data.Monoid
@@ -272,6 +273,9 @@ whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
 whamletFile :: FilePath -> Q Exp
 whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings
 
+whamletFileWithSettings :: NP.HamletSettings -> FilePath -> Q Exp
+whamletFileWithSettings = NP.hamletFileWithSettings rules
+
 rules :: Q NP.HamletRules
 rules = do
     ah <- [|toWidget|]

yesod-default/Yesod/Default/Util.hs

@@ -7,7 +7,11 @@ module Yesod.Default.Util
     , globFile
     , widgetFileNoReload
     , widgetFileReload
-    , widgetFileJsCss
+    , TemplateLanguage (..)
+    , defaultTemplateLanguages
+    , WidgetFileSettings
+    , wfsLanguages
+    , wfsHamletSettings
     ) where
 
 import Control.Monad.IO.Class (liftIO)
@@ -20,7 +24,9 @@ import Language.Haskell.TH.Syntax
 import Text.Lucius (luciusFile, luciusFileReload)
 import Text.Julius (juliusFile, juliusFileReload)
 import Text.Cassius (cassiusFile, cassiusFileReload)
+import Text.Hamlet (HamletSettings, defaultHamletSettings)
 import Data.Maybe (catMaybes)
+import Data.Default (Default (def))
 
 -- | An implementation of 'addStaticContent' which stores the contents in an
 -- external file. Files are created in the given static folder with names based
@@ -57,34 +63,40 @@ addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
 globFile :: String -> String -> FilePath
 globFile kind x = "templates/" ++ x ++ "." ++ kind
 
-widgetFileNoReload :: FilePath -> Q Exp
+data TemplateLanguage = TemplateLanguage
-widgetFileNoReload x = combine "widgetFileNoReload" x
+    { tlRequiresToWidget :: Bool
-    [ whenExists x False "hamlet"  whamletFile
+    , tlExtension :: String
-    , whenExists x True  "cassius" cassiusFile
+    , tlNoReload :: FilePath -> Q Exp
-    , whenExists x True  "julius"  juliusFile
+    , tlReload :: FilePath -> Q Exp
-    , whenExists x True  "lucius"  luciusFile
+    }
-    ]
 
-widgetFileReload :: FilePath -> Q Exp
+defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
-widgetFileReload x = combine "widgetFileReload" x
+defaultTemplateLanguages hset =
-    [ whenExists x False "hamlet"  whamletFile
+    [ TemplateLanguage False "hamlet"  whamletFile' whamletFile'
-    , whenExists x True  "cassius" cassiusFileReload
+    , TemplateLanguage True  "cassius" cassiusFile  cassiusFileReload
-    , whenExists x True  "julius"  juliusFileReload
+    , TemplateLanguage True  "julius"  juliusFile   juliusFileReload
-    , whenExists x True  "lucius"  luciusFileReload
+    , TemplateLanguage True  "lucius"  luciusFile   luciusFileReload
     ]
+  where
+    whamletFile' = whamletFileWithSettings hset
 
-widgetFileJsCss :: (String, FilePath -> Q Exp) -- ^ JavaScript file extenstion and loading function. example: ("julius", juliusFileReload)
+data WidgetFileSettings = WidgetFileSettings
-                -> (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("cassius", cassiusFileReload)
+    { wfsLanguages :: HamletSettings -> [TemplateLanguage]
-                -> FilePath -> Q Exp
+    , wfsHamletSettings :: HamletSettings
-widgetFileJsCss (jsExt, jsLoad) (csExt, csLoad) x = combine "widgetFileJsCss" x
+    }
-    [ whenExists x False "hamlet"  whamletFile
-    , whenExists x True  csExt csLoad
-    , whenExists x True  jsExt jsLoad
-    ]
 
-combine :: String -> String -> [Q (Maybe Exp)] -> Q Exp
+instance Default WidgetFileSettings where
-combine func file qmexps = do
+    def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
-    mexps <- sequence qmexps
+
+widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp
+widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs
+
+widgetFileReload :: WidgetFileSettings -> FilePath -> Q Exp
+widgetFileReload wfs x = combine "widgetFileReload" x True $ wfsLanguages wfs $ wfsHamletSettings wfs
+
+combine :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp
+combine func file isReload tls = do
+    mexps <- qmexps
     case catMaybes mexps of
         [] -> error $ concat
             [ "Called "
@@ -94,6 +106,12 @@ combine func file qmexps = do
             , ", but no template were found."
             ]
         exps -> return $ DoE $ map NoBindS exps
+  where
+    qmexps :: Q [Maybe Exp]
+    qmexps = mapM go tls
+
+    go :: TemplateLanguage -> Q (Maybe Exp)
+    go tl = whenExists file (tlRequiresToWidget tl) (tlExtension tl) ((if isReload then tlReload else tlNoReload) tl)
 
 whenExists :: String
            -> Bool -- ^ requires toWidget wrap

yesod-default/yesod-default.cabal

@@ -32,6 +32,8 @@ library
                    , yaml                  >= 0.8     && < 0.9
                    , network-conduit       >= 0.5     && < 0.6
                    , unordered-containers
+                   , hamlet                >= 1.1     && < 1.2
+                   , data-default
 
     if !os(windows)
          build-depends: unix