haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added addJavaScript for widgets

Browse Source
This commit is contained in:
Michael Snoyman 2010-07-10 21:48:16 +03:00
parent 7d273861e2
commit 2c0434c431
1 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
Yesod/Widget.hs
View File

@ -20,6 +20,7 @@ module Yesod.Widget
, addScriptRemote , addScriptRemote
, addHead , addHead
, addBody , addBody
, addJavaScript
-- * Manipulating -- * Manipulating
, wrapWidget , wrapWidget
, extractBody , extractBody
@ -65,6 +66,8 @@ newtype Head url = Head (Hamlet url)
deriving Monoid deriving Monoid
newtype Body url = Body (Hamlet url) newtype Body url = Body (Hamlet url)
deriving Monoid deriving Monoid
newtype JavaScript url = JavaScript (Hamlet url)
deriving Monoid
newtype GWidget sub master a = GWidget ( newtype GWidget sub master a = GWidget (
WriterT (Body (Route master)) ( WriterT (Body (Route master)) (
@ -72,10 +75,11 @@ newtype GWidget sub master a = GWidget (
WriterT (UniqueList (Script (Route master))) ( WriterT (UniqueList (Script (Route master))) (
WriterT (UniqueList (Stylesheet (Route master))) ( WriterT (UniqueList (Stylesheet (Route master))) (
WriterT (Style (Route master)) ( WriterT (Style (Route master)) (
WriterT (JavaScript (Route master)) (
WriterT (Head (Route master)) ( WriterT (Head (Route master)) (
StateT Int ( StateT Int (
GHandler sub master GHandler sub master
))))))) a) )))))))) a)
deriving (Functor, Applicative, Monad, MonadIO, MonadCatchIO) deriving (Functor, Applicative, Monad, MonadIO, MonadCatchIO)
instance Monoid (GWidget sub master ()) where instance Monoid (GWidget sub master ()) where
mempty = return () mempty = return ()
@ -86,13 +90,13 @@ setTitle :: Html () -> GWidget sub master ()
setTitle = GWidget . lift . tell . Last . Just . Title setTitle = GWidget . lift . tell . Last . Just . Title
addHead :: Hamlet (Route master) -> GWidget sub master () addHead :: Hamlet (Route master) -> GWidget sub master ()
addHead = GWidget . lift . lift . lift . lift . lift . tell . Head addHead = GWidget . lift . lift . lift . lift . lift . lift . tell . Head
addBody :: Hamlet (Route master) -> GWidget sub master () addBody :: Hamlet (Route master) -> GWidget sub master ()
addBody = GWidget . tell . Body addBody = GWidget . tell . Body
newIdent :: GWidget sub master String newIdent :: GWidget sub master String
newIdent = GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ do newIdent = GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift $ do
i <- get i <- get
let i' = i + 1 let i' = i + 1
put i' put i'
@ -115,6 +119,9 @@ addScriptRemote :: String -> GWidget sub master ()
addScriptRemote = addScriptRemote =
GWidget . lift . lift . tell . toUnique . Script . Remote GWidget . lift . lift . tell . toUnique . Script . Remote
addJavaScript :: Hamlet (Route master) -> GWidget sub master ()
addJavaScript = GWidget . lift . lift . lift . lift . lift. tell . JavaScript
applyLayoutW :: (Eq (Route m), Yesod m) applyLayoutW :: (Eq (Route m), Yesod m)
=> GWidget sub m () -> GHandler sub m RepHtml => GWidget sub m () -> GHandler sub m RepHtml
applyLayoutW w = widgetToPageContent w >>= fmap RepHtml . defaultLayout applyLayoutW w = widgetToPageContent w >>= fmap RepHtml . defaultLayout
@ -125,13 +132,14 @@ widgetToPageContent :: Eq (Route master)
widgetToPageContent (GWidget w) = do widgetToPageContent (GWidget w) = do
w' <- flip evalStateT 0 w' <- flip evalStateT 0
$ runWriterT $ runWriterT $ runWriterT $ runWriterT $ runWriterT $ runWriterT $ runWriterT $ runWriterT
$ runWriterT $ runWriterT w $ runWriterT $ runWriterT $ runWriterT w
let (((((((), let ((((((((),
Body body), Body body),
Last mTitle), Last mTitle),
scripts'), scripts'),
stylesheets'), stylesheets'),
Style style), Style style),
JavaScript jscript),
Head head') = w' Head head') = w'
let title = maybe mempty unTitle mTitle let title = maybe mempty unTitle mTitle
let scripts = map (locationToHamlet . unScript) $ runUniqueList scripts' let scripts = map (locationToHamlet . unScript) $ runUniqueList scripts'
@ -142,8 +150,8 @@ $forall scripts s
%script!src=^s^ %script!src=^s^
$forall stylesheets s $forall stylesheets s
%link!rel=stylesheet!href=^s^ %link!rel=stylesheet!href=^s^
%style %style ^style^
^style^ %script ^jscript^
^head'^ ^head'^
|] |]
return $ PageContent title head'' body return $ PageContent title head'' body