yepnopeJs

scripts

@@ -1 +1 @@
-Subproject commit 2fc59a850bdc49e01f7a5e062b813df321ce5c78
+Subproject commit e791ced0395245e30d37b5098a27bba5e818ecb7

yesod-core/Yesod/Internal/Core.hs

@@ -52,7 +52,7 @@ import Control.Monad.Trans.RWS
 import Text.Hamlet
 import Text.Cassius
 import Text.Julius
-import Text.Blaze ((!), customAttribute, textTag, toValue)
+import Text.Blaze ((!), customAttribute, textTag, toValue, unsafeLazyByteString)
 import qualified Text.Blaze.Html5 as TBH
 import Data.Text.Lazy.Builder (toLazyText)
 import Data.Text.Lazy.Encoding (encodeUtf8)
@@ -75,6 +75,9 @@ import qualified Data.Text.Lazy.IO
 import qualified Data.Text.Lazy.Builder as TB
 import Language.Haskell.TH.Syntax (Loc (..), Lift (..))
 import Text.Blaze (preEscapedLazyText)
+import Data.Aeson (Value (Array, String))
+import Data.Aeson.Encode (encode)
+import qualified Data.Vector as Vector
 
 #if GHC7
 #define HAMLET hamlet
@@ -264,6 +267,11 @@ class RenderRoute (Route a) => Yesod a where
     gzipCompressFiles :: a -> Bool
     gzipCompressFiles _ = False
 
+    -- | Location of yepnope.js, if any. If one is provided, then all
+    -- Javascript files will be loaded asynchronously.
+    yepnopeJs :: a -> Maybe (Either Text (Route a))
+    yepnopeJs _ = Nothing
+
 messageLoggerHandler :: (Yesod m, MonadIO mo)
                      => Loc -> LogLevel -> Text -> GGHandler s m mo ()
 messageLoggerHandler loc level msg = do
@@ -472,18 +480,22 @@ maybeAuthorized r isWrite = do
     x <- isAuthorized r isWrite
     return $ if x == Authorized then Just r else Nothing
 
+jsToHtml :: Javascript -> Html
+jsToHtml (Javascript b) = preEscapedLazyText $ toLazyText b
+
+jelper :: JavascriptUrl url -> HtmlUrl url
+jelper = fmap jsToHtml
+
 -- | Convert a widget to a 'PageContent'.
 widgetToPageContent :: (Eq (Route master), Yesod master)
                     => GWidget sub master ()
                     -> GHandler sub master (PageContent (Route master))
 widgetToPageContent (GWidget w) = do
+    master <- getYesod
     ((), _, GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- runRWST w () 0
     let title = maybe mempty unTitle mTitle
     let scripts = runUniqueList scripts'
     let stylesheets = runUniqueList stylesheets'
-    let jsToHtml (Javascript b) = preEscapedLazyText $ toLazyText b
-        jelper :: JavascriptUrl url -> HtmlUrl url
-        jelper = fmap jsToHtml
 
     render <- getUrlRenderParams
     let renderLoc x =
@@ -536,16 +548,54 @@ $forall s <- css
             <style media=#{media}>#{content}
         $nothing
             <style>#{content}
-$forall s <- scripts
-    ^{mkScriptTag s}
-$maybe j <- jscript
-    $maybe s <- jsLoc
-        <script src="#{s}">
-    $nothing
-        <script>^{jelper j}
+$maybe _ <- yepnopeJs master
+$nothing
+    $forall s <- scripts
+        ^{mkScriptTag s}
+    $maybe j <- jscript
+        $maybe s <- jsLoc
+            <script src="#{s}">
+        $nothing
+            <script>^{jelper j}
 \^{head'}
 |]
-    return $ PageContent title head'' body
+    let (mcomplete, ynscripts) = ynHelper render scripts jscript jsLoc
+    let bodyYN = [HAMLET|
+^{body}
+$maybe eyn <- yepnopeJs master
+    $maybe yn <- left eyn
+        <script src=#{yn}>
+    $maybe yn <- right eyn
+        <script src=@{yn}>
+    $maybe complete <- mcomplete
+        <script>yepnope({load:#{ynscripts},complete:function(){^{complete}}})
+    $nothing
+        <script>yepnope({load:#{ynscripts})
+|]
+    return $ PageContent title head'' bodyYN
+
+ynHelper :: (url -> [x] -> Text)
+         -> [Script (url)]
+         -> Maybe (JavascriptUrl (url))
+         -> Maybe Text
+         -> (Maybe (HtmlUrl (url)), Html)
+ynHelper render scripts jscript jsLoc =
+    (mcomplete, unsafeLazyByteString $ encode $ Array $ Vector.fromList $ map String scripts'')
+  where
+    scripts' = map goScript scripts
+    scripts'' =
+        case jsLoc of
+            Just s -> scripts' ++ [s]
+            Nothing -> scripts'
+    goScript (Script (Local url) _) = render url []
+    goScript (Script (Remote s) _) = s
+    mcomplete =
+        case jsLoc of
+            Just{} -> Nothing
+            Nothing ->
+                case jscript of
+                    Nothing -> Nothing
+                    Just j -> Just $ jelper j
 
 yesodVersion :: String
 yesodVersion = showVersion Paths_yesod_core.version

yesod-core/helloworld.hs

@@ -5,10 +5,13 @@
 import Yesod.Core
 import Network.Wai.Handler.Warp (run)
 import Data.Text (unpack)
+import Text.Julius (julius)
 
 data Subsite = Subsite String
 
-mkYesodSub "Subsite" [] [$parseRoutes|
+type Strings = [String]
+
+mkYesodSub "Subsite" [] [parseRoutes|
 / SubRootR GET
 /multi/*Strings SubMultiR
 |]
@@ -32,9 +35,15 @@ mkYesod "HelloWorld" [$parseRoutes|
 / RootR GET
 /subsite/#String SubsiteR Subsite getSubsite
 |]
-instance Yesod HelloWorld where approot _ = ""
--- getRootR :: GHandler HelloWorld HelloWorld RepPlain -- FIXME remove type sig
+instance Yesod HelloWorld where
+    approot _ = ""
+    yepnopeJs _ = Just $ Left "http://cdnjs.cloudflare.com/ajax/libs/modernizr/2.0.6/modernizr.min.js"
+
 getRootR = do
     $(logOther "HAHAHA") "Here I am"
-    return $ RepPlain "Hello World"
+    defaultLayout $ do
+        addScriptRemote "https://ajax.googleapis.com/ajax/libs/jquery/1.6.4/jquery.min.js"
+        toWidget [julius|$(function(){$("#mypara").css("color", "red")});|]
+        [whamlet|<p #mypara>Hello World|]
+
 main = toWaiApp (HelloWorld Subsite) >>= run 3000

yesod-core/yesod-core.cabal

@@ -58,6 +58,8 @@ library
                    , data-object-yaml          >= 0.3      && < 0.4
                    -- for logger. Probably logger should be a separate package
                    , strict-concurrency        >= 0.2.4    && < 0.2.5
+                   , vector                    >= 0.9      && < 0.10
+                   , aeson-native              >= 0.3.3.1  && < 0.4
 
     exposed-modules: Yesod.Content
                      Yesod.Core