yepnopeJs
This commit is contained in:
parent
c9bb4fe622
commit
1f3df69787
2
scripts
2
scripts
@ -1 +1 @@
|
|||||||
Subproject commit 2fc59a850bdc49e01f7a5e062b813df321ce5c78
|
Subproject commit e791ced0395245e30d37b5098a27bba5e818ecb7
|
||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user