yesodweb · jmorag · Jun 23, 2020 · Jun 23, 2020 · Jun 23, 2020 · Jun 23, 2020
diff --git 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
@@ -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 <head> 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
@@ -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,29 +400,31 @@ 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)
         (mappend a4 b4)
         (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
@@ -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,14 +149,20 @@ 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
 
 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,15 +271,15 @@ 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 ()
 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,15 +297,15 @@ 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 ()
 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
@@ -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 "<!DOCTYPE html>\n<html><head><title></title><script>toHead</script><toHead></toHead>\n<style>toWidget{bar:baz}toHead{bar:baz}</style></head><body><script>toBody</script><p>toWidget</p>\n<p>toBody</p>\n<script>toWidget</script></body></html>" res
+    assertBody "<!DOCTYPE html>\n<html><head><title></title><script>toHead</script><script type=\"module\">toHeadModule</script><toHead></toHead>\n<style>toWidget{bar:baz}toHead{bar:baz}</style></head><body><script>toBody</script><script type=\"module\">toBodyModule</script><p>toWidget</p>\n<p>toBody</p>\n<script>toWidget</script></body></html>" res
 
 runner :: Session () -> IO ()
 runner f = toWaiAppPlain Y >>= runSession f

diff --git 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