diff --git a/.gitignore b/.gitignore
index 8f84fbea7..0145e947f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,6 +4,7 @@
*.hi
dist/
dist-stack/
+dist-newstyle/
stack.yaml.lock
.stack-work
*.swp
diff --git a/yesod-core/src/Yesod/Core/Class/Yesod.hs b/yesod-core/src/Yesod/Core/Class/Yesod.hs
index 2a2c1b047..f645c9b0c 100644
--- a/yesod-core/src/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/src/Yesod/Core/Class/Yesod.hs
@@ -539,7 +539,7 @@ widgetToPageContent w = do
{ wdRef = ref
, wdHandler = hd
}
- GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head') <- readIORef ref
+ GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript jsmodule (Head head') <- readIORef ref
let title = maybe mempty unTitle mTitle
scripts = runUniqueList scripts'
stylesheets = runUniqueList stylesheets'
@@ -566,6 +566,14 @@ widgetToPageContent w = do
x <- addStaticContent "js" "text/javascript; charset=utf-8"
$ encodeUtf8 $ renderJavascriptUrl render s
return $ renderLoc x
+ jsModule <-
+ case jsmodule of
+ Nothing -> return Nothing
+ Just s -> do
+ x <- addStaticContent "mjs" "module; charset=utf-8"
+ $ encodeUtf8 $ renderJavascriptModuleUrl render s
+ return $ renderLoc x
+
-- modernizr should be at the end of the http://www.modernizr.com/docs/#installing
-- the asynchronous loader means your page doesn't have to wait for all the js to load
diff --git a/yesod-core/src/Yesod/Core/Types.hs b/yesod-core/src/Yesod/Core/Types.hs
index 11a55f1a9..c7250dac4 100644
--- a/yesod-core/src/Yesod/Core/Types.hs
+++ b/yesod-core/src/Yesod/Core/Types.hs
@@ -47,7 +47,7 @@ import System.Log.FastLogger (LogStr, LoggerSet, toLogStr
import Network.Wai.Logger (DateCacheGetter)
import Text.Blaze.Html (Html, toHtml)
import Text.Hamlet (HtmlUrl)
-import Text.Julius (JavascriptUrl)
+import Text.Julius (JavascriptUrl, JavascriptModuleUrl)
import Web.Cookie (SetCookie)
import Yesod.Core.Internal.Util (getTime, putTime)
import Yesod.Routes.Class (RenderRoute (..), ParseRoute (..))
@@ -400,22 +400,23 @@ instance Semigroup (Body url) where
type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> TBuilder.Builder
data GWData a = GWData
- { gwdBody :: !(Body a)
- , gwdTitle :: !(Last Title)
- , gwdScripts :: !(UniqueList (Script a))
- , gwdStylesheets :: !(UniqueList (Stylesheet a))
- , gwdCss :: !(Map (Maybe Text) (CssBuilderUrl a)) -- media type
- , gwdJavascript :: !(Maybe (JavascriptUrl a))
- , gwdHead :: !(Head a)
+ { gwdBody :: !(Body a)
+ , gwdTitle :: !(Last Title)
+ , gwdScripts :: !(UniqueList (Script a))
+ , gwdStylesheets :: !(UniqueList (Stylesheet a))
+ , gwdCss :: !(Map (Maybe Text) (CssBuilderUrl a)) -- media type
+ , gwdJavascript :: !(Maybe (JavascriptUrl a))
+ , gwdJavascriptModule :: !(Maybe (JavascriptModuleUrl a))
+ , gwdHead :: !(Head a)
}
instance Monoid (GWData a) where
- mempty = GWData mempty mempty mempty mempty mempty mempty mempty
+ mempty = GWData mempty mempty mempty mempty mempty mempty mempty mempty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
instance Semigroup (GWData a) where
- GWData a1 a2 a3 a4 a5 a6 a7 <>
- GWData b1 b2 b3 b4 b5 b6 b7 = GWData
+ GWData a1 a2 a3 a4 a5 a6 a7 a8 <>
+ GWData b1 b2 b3 b4 b5 b6 b7 b8 = GWData
(mappend a1 b1)
(mappend a2 b2)
(mappend a3 b3)
@@ -423,6 +424,7 @@ instance Semigroup (GWData a) where
(unionWith mappend a5 b5)
(mappend a6 b6)
(mappend a7 b7)
+ (mappend a8 b8)
data HandlerContents =
HCContent !H.Status !TypedContent
diff --git a/yesod-core/src/Yesod/Core/Widget.hs b/yesod-core/src/Yesod/Core/Widget.hs
index 205697903..2bea88cfb 100644
--- a/yesod-core/src/Yesod/Core/Widget.hs
+++ b/yesod-core/src/Yesod/Core/Widget.hs
@@ -9,6 +9,7 @@
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
-- | Widgets combine HTML with JS and CSS dependencies with a unique identifier
-- generator, allowing you to create truly modular HTML components.
@@ -57,6 +58,7 @@ module Yesod.Core.Widget
import Data.Monoid
import qualified Text.Blaze.Html5 as H
+import Text.Blaze.Html5.Attributes (type_)
import Text.Hamlet
import Text.Cassius
import Text.Julius
@@ -87,19 +89,23 @@ class ToWidget site a where
toWidget :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
instance render ~ RY site => ToWidget site (render -> Html) where
- toWidget x = tell $ GWData (Body x) mempty mempty mempty mempty mempty mempty
+ toWidget x = tell $ GWData (Body x) mempty mempty mempty mempty mempty mempty mempty
instance render ~ RY site => ToWidget site (render -> Css) where
toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . x
instance ToWidget site Css where
toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . const x
instance render ~ RY site => ToWidget site (render -> CssBuilder) where
- toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . x) mempty mempty
+ toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . x) mempty mempty mempty
instance ToWidget site CssBuilder where
- toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . const x) mempty mempty
+ toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . const x) mempty mempty mempty
instance render ~ RY site => ToWidget site (render -> Javascript) where
- toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty
+ toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty mempty
instance ToWidget site Javascript where
- toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just $ const x) mempty
+ toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just $ const x) mempty mempty
+instance render ~ RY site => ToWidget site (render -> JavascriptModule) where
+ toWidget x = tell $ GWData mempty mempty mempty mempty mempty mempty (Just x) mempty
+instance ToWidget site JavascriptModule where
+ toWidget x = tell $ GWData mempty mempty mempty mempty mempty mempty (Just $ const x) mempty
instance (site' ~ site, a ~ ()) => ToWidget site' (WidgetFor site a) where
toWidget = liftWidget
instance ToWidget site Html where
@@ -130,9 +136,9 @@ instance render ~ RY site => ToWidgetMedia site (render -> Css) where
instance ToWidgetMedia site Css where
toWidgetMedia media x = toWidgetMedia media $ CssBuilder . fromLazyText . renderCss . const x
instance render ~ RY site => ToWidgetMedia site (render -> CssBuilder) where
- toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . x) mempty mempty
+ toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . x) mempty mempty mempty
instance ToWidgetMedia site CssBuilder where
- toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . const x) mempty mempty
+ toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . const x) mempty mempty mempty
class ToWidgetBody site a where
toWidgetBody :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
@@ -143,6 +149,12 @@ instance render ~ RY site => ToWidgetBody site (render -> Javascript) where
toWidgetBody j = toWidget $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
instance ToWidgetBody site Javascript where
toWidgetBody j = toWidget $ \_ -> H.script $ preEscapedLazyText $ renderJavascript j
+instance render ~ RY site => ToWidgetBody site (render -> JavascriptModule) where
+ toWidgetBody j = toWidget $
+ \r -> H.script H.! type_ "module" $ preEscapedLazyText $ renderJavascriptModuleUrl r j
+instance ToWidgetBody site JavascriptModule where
+ toWidgetBody j = toWidget $
+ \_ -> H.script H.! type_ "module" $ preEscapedLazyText $ renderJavascriptModule j
instance ToWidgetBody site Html where
toWidgetBody = toWidget
@@ -150,7 +162,7 @@ class ToWidgetHead site a where
toWidgetHead :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
instance render ~ RY site => ToWidgetHead site (render -> Html) where
- toWidgetHead = tell . GWData mempty mempty mempty mempty mempty mempty . Head
+ toWidgetHead = tell . GWData mempty mempty mempty mempty mempty mempty mempty . Head
instance render ~ RY site => ToWidgetHead site (render -> Css) where
toWidgetHead = toWidget
instance ToWidgetHead site Css where
@@ -163,6 +175,13 @@ instance render ~ RY site => ToWidgetHead site (render -> Javascript) where
toWidgetHead j = toWidgetHead $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
instance ToWidgetHead site Javascript where
toWidgetHead j = toWidgetHead $ \_ -> H.script $ preEscapedLazyText $ renderJavascript j
+instance render ~ RY site => ToWidgetHead site (render -> JavascriptModule) where
+ toWidgetHead j = toWidgetHead $
+ \r -> H.script H.! type_ "module" $
+ preEscapedLazyText $ renderJavascriptModuleUrl r j
+instance ToWidgetHead site JavascriptModule where
+ toWidgetHead j = toWidgetHead $
+ \_ -> H.script H.! type_ "module" $ preEscapedLazyText $ renderJavascriptModule j
instance ToWidgetHead site Html where
toWidgetHead = toWidgetHead . const
@@ -181,7 +200,7 @@ instance ToWidgetHead site Html where
-- * Google typically shows 55-64 characters, so aim to keep your title
-- length under 60 characters
setTitle :: MonadWidget m => Html -> m ()
-setTitle x = tell $ GWData mempty (Last $ Just $ Title x) mempty mempty mempty mempty mempty
+setTitle x = tell $ GWData mempty (Last $ Just $ Title x) mempty mempty mempty mempty mempty mempty
-- | Set the localised page title.
--
@@ -252,7 +271,7 @@ addStylesheetAttrs :: MonadWidget m
=> Route (HandlerSite m)
-> [(Text, Text)]
-> m ()
-addStylesheetAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Local x) y) mempty mempty mempty
+addStylesheetAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Local x) y) mempty mempty mempty mempty
-- | Link to the specified remote stylesheet.
addStylesheetRemote :: MonadWidget m => Text -> m ()
@@ -260,7 +279,7 @@ addStylesheetRemote = flip addStylesheetRemoteAttrs []
-- | Link to the specified remote stylesheet.
addStylesheetRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()
-addStylesheetRemoteAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Remote x) y) mempty mempty mempty
+addStylesheetRemoteAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Remote x) y) mempty mempty mempty mempty
addStylesheetEither :: MonadWidget m
=> Either (Route (HandlerSite m)) Text
@@ -278,7 +297,7 @@ addScript = flip addScriptAttrs []
-- | Link to the specified local script.
addScriptAttrs :: MonadWidget m => Route (HandlerSite m) -> [(Text, Text)] -> m ()
-addScriptAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Local x) y) mempty mempty mempty mempty
+addScriptAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Local x) y) mempty mempty mempty mempty mempty
-- | Link to the specified remote script.
addScriptRemote :: MonadWidget m => Text -> m ()
@@ -286,7 +305,7 @@ addScriptRemote = flip addScriptRemoteAttrs []
-- | Link to the specified remote script.
addScriptRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()
-addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
+addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty mempty
whamlet :: QuasiQuoter
whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
diff --git a/yesod-core/test/YesodCoreTest/Widget.hs b/yesod-core/test/YesodCoreTest/Widget.hs
index 7d71a18a1..c120a58db 100644
--- a/yesod-core/test/YesodCoreTest/Widget.hs
+++ b/yesod-core/test/YesodCoreTest/Widget.hs
@@ -9,6 +9,7 @@ module YesodCoreTest.Widget
import Test.Hspec
import Yesod.Core
+import Text.Julius (juliusModule)
import Network.Wai
import Network.Wai.Test
@@ -75,7 +76,9 @@ getTowidgetR :: Handler Html
getTowidgetR = defaultLayout $ do
toWidget [julius|toWidget|] :: Widget
toWidgetHead [julius|toHead|]
+ toWidgetHead [juliusModule|toHeadModule|]
toWidgetBody [julius|toBody|]
+ toWidgetBody [juliusModule|toBodyModule|]
toWidget [lucius|toWidget{bar:baz}|]
toWidgetHead [lucius|toHead{bar:baz}|]
@@ -95,7 +98,7 @@ widgetTest = describe "Test.Widget" $ do
res <- request defaultRequest
{ pathInfo = ["towidget"]
}
- assertBody "\n\ntoWidget
\ntoBody
\n" res
+ assertBody "\n\ntoWidget
\ntoBody
\n" res
runner :: Session () -> IO ()
runner f = toWaiAppPlain Y >>= runSession f
diff --git a/yesod/Yesod/Default/Util.hs b/yesod/Yesod/Default/Util.hs
index 205141393..d1a423316 100644
--- a/yesod/Yesod/Default/Util.hs
+++ b/yesod/Yesod/Default/Util.hs
@@ -24,7 +24,7 @@ import Conduit
import System.Directory (doesFileExist, createDirectoryIfMissing)
import Language.Haskell.TH.Syntax
import Text.Lucius (luciusFile, luciusFileReload)
-import Text.Julius (juliusFile, juliusFileReload)
+import Text.Julius (juliusFile, juliusFileReload, juliusModuleFile, juliusModuleFileReload)
import Text.Cassius (cassiusFile, cassiusFileReload)
import Text.Hamlet (HamletSettings, defaultHamletSettings)
import Data.Maybe (catMaybes)
@@ -80,10 +80,11 @@ data TemplateLanguage = TemplateLanguage
defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
defaultTemplateLanguages hset =
- [ TemplateLanguage False "hamlet" whamletFile' whamletFile'
- , TemplateLanguage True "cassius" cassiusFile cassiusFileReload
- , TemplateLanguage True "julius" juliusFile juliusFileReload
- , TemplateLanguage True "lucius" luciusFile luciusFileReload
+ [ TemplateLanguage False "hamlet" whamletFile' whamletFile'
+ , TemplateLanguage True "cassius" cassiusFile cassiusFileReload
+ , TemplateLanguage True "julius" juliusFile juliusFileReload
+ , TemplateLanguage True "mjulius" juliusModuleFile juliusModuleFileReload
+ , TemplateLanguage True "lucius" luciusFile luciusFileReload
]
where
whamletFile' = whamletFileWithSettings hset