yepnopeJs

This commit is contained in:
Michael Snoyman 2011-09-23 09:22:06 +03:00
parent c9bb4fe622
commit 1f3df69787
4 changed files with 78 additions and 17 deletions

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

View File

@ -52,7 +52,7 @@ import Control.Monad.Trans.RWS
import Text.Hamlet import Text.Hamlet
import Text.Cassius import Text.Cassius
import Text.Julius import Text.Julius
import Text.Blaze ((!), customAttribute, textTag, toValue) import Text.Blaze ((!), customAttribute, textTag, toValue, unsafeLazyByteString)
import qualified Text.Blaze.Html5 as TBH import qualified Text.Blaze.Html5 as TBH
import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Encoding (encodeUtf8) 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 qualified Data.Text.Lazy.Builder as TB
import Language.Haskell.TH.Syntax (Loc (..), Lift (..)) import Language.Haskell.TH.Syntax (Loc (..), Lift (..))
import Text.Blaze (preEscapedLazyText) import Text.Blaze (preEscapedLazyText)
import Data.Aeson (Value (Array, String))
import Data.Aeson.Encode (encode)
import qualified Data.Vector as Vector
#if GHC7 #if GHC7
#define HAMLET hamlet #define HAMLET hamlet
@ -264,6 +267,11 @@ class RenderRoute (Route a) => Yesod a where
gzipCompressFiles :: a -> Bool gzipCompressFiles :: a -> Bool
gzipCompressFiles _ = False 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) messageLoggerHandler :: (Yesod m, MonadIO mo)
=> Loc -> LogLevel -> Text -> GGHandler s m mo () => Loc -> LogLevel -> Text -> GGHandler s m mo ()
messageLoggerHandler loc level msg = do messageLoggerHandler loc level msg = do
@ -472,18 +480,22 @@ maybeAuthorized r isWrite = do
x <- isAuthorized r isWrite x <- isAuthorized r isWrite
return $ if x == Authorized then Just r else Nothing 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'. -- | Convert a widget to a 'PageContent'.
widgetToPageContent :: (Eq (Route master), Yesod master) widgetToPageContent :: (Eq (Route master), Yesod master)
=> GWidget sub master () => GWidget sub master ()
-> GHandler sub master (PageContent (Route master)) -> GHandler sub master (PageContent (Route master))
widgetToPageContent (GWidget w) = do widgetToPageContent (GWidget w) = do
master <- getYesod
((), _, GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- runRWST w () 0 ((), _, GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- runRWST w () 0
let title = maybe mempty unTitle mTitle let title = maybe mempty unTitle mTitle
let scripts = runUniqueList scripts' let scripts = runUniqueList scripts'
let stylesheets = runUniqueList stylesheets' let stylesheets = runUniqueList stylesheets'
let jsToHtml (Javascript b) = preEscapedLazyText $ toLazyText b
jelper :: JavascriptUrl url -> HtmlUrl url
jelper = fmap jsToHtml
render <- getUrlRenderParams render <- getUrlRenderParams
let renderLoc x = let renderLoc x =
@ -536,16 +548,54 @@ $forall s <- css
<style media=#{media}>#{content} <style media=#{media}>#{content}
$nothing $nothing
<style>#{content} <style>#{content}
$forall s <- scripts $maybe _ <- yepnopeJs master
^{mkScriptTag s} $nothing
$maybe j <- jscript $forall s <- scripts
$maybe s <- jsLoc ^{mkScriptTag s}
<script src="#{s}"> $maybe j <- jscript
$nothing $maybe s <- jsLoc
<script>^{jelper j} <script src="#{s}">
$nothing
<script>^{jelper j}
\^{head'} \^{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 :: String
yesodVersion = showVersion Paths_yesod_core.version yesodVersion = showVersion Paths_yesod_core.version

View File

@ -5,10 +5,13 @@
import Yesod.Core import Yesod.Core
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import Data.Text (unpack) import Data.Text (unpack)
import Text.Julius (julius)
data Subsite = Subsite String data Subsite = Subsite String
mkYesodSub "Subsite" [] [$parseRoutes| type Strings = [String]
mkYesodSub "Subsite" [] [parseRoutes|
/ SubRootR GET / SubRootR GET
/multi/*Strings SubMultiR /multi/*Strings SubMultiR
|] |]
@ -32,9 +35,15 @@ mkYesod "HelloWorld" [$parseRoutes|
/ RootR GET / RootR GET
/subsite/#String SubsiteR Subsite getSubsite /subsite/#String SubsiteR Subsite getSubsite
|] |]
instance Yesod HelloWorld where approot _ = "" instance Yesod HelloWorld where
-- getRootR :: GHandler HelloWorld HelloWorld RepPlain -- FIXME remove type sig approot _ = ""
yepnopeJs _ = Just $ Left "http://cdnjs.cloudflare.com/ajax/libs/modernizr/2.0.6/modernizr.min.js"
getRootR = do getRootR = do
$(logOther "HAHAHA") "Here I am" $(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 main = toWaiApp (HelloWorld Subsite) >>= run 3000

View File

@ -58,6 +58,8 @@ library
, data-object-yaml >= 0.3 && < 0.4 , data-object-yaml >= 0.3 && < 0.4
-- for logger. Probably logger should be a separate package -- for logger. Probably logger should be a separate package
, strict-concurrency >= 0.2.4 && < 0.2.5 , 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 exposed-modules: Yesod.Content
Yesod.Core Yesod.Core