From a9a373073156abe4f94d8ceb3b96ab93489a9fc7 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 8 Aug 2010 10:48:32 +0300 Subject: [PATCH] Camlet and Jamlet --- Yesod/Form/Jquery.hs | 6 +++--- Yesod/Form/Nic.hs | 2 +- Yesod/Hamlet.hs | 6 +++++- Yesod/Widget.hs | 38 +++++++++++++++++++++++--------------- hellowidget.hs | 42 +++++++++++++++++++++++++++++------------- yesod.cabal | 3 ++- 6 files changed, 63 insertions(+), 34 deletions(-) diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs index d670fde1..882fdcf2 100644 --- a/Yesod/Form/Jquery.hs +++ b/Yesod/Form/Jquery.hs @@ -55,7 +55,7 @@ jqueryDayFieldProfile = FieldProfile addScript' urlJqueryJs addScript' urlJqueryUiJs addStylesheet' urlJqueryUiCss - addJavaScript [$hamlet| + addJavaScript [$jamlet| $$(function(){$$("#$name$").datepicker({dateFormat:'yy-mm-dd'})}); |] } @@ -93,7 +93,7 @@ jqueryDayTimeFieldProfile = FieldProfile addScript' urlJqueryUiJs addScript' urlJqueryUiDateTimePicker addStylesheet' urlJqueryUiCss - addJavaScript [$hamlet| + addJavaScript [$jamlet| $$(function(){$$("#$name$").datetimepicker({dateFormat : "yyyy/mm/dd h:MM TT"})}); |] } @@ -128,7 +128,7 @@ jqueryAutocompleteFieldProfile src = FieldProfile addScript' urlJqueryJs addScript' urlJqueryUiJs addStylesheet' urlJqueryUiCss - addJavaScript [$hamlet| + addJavaScript [$jamlet| $$(function(){$$("#$name$").autocomplete({source:"@src@",minLength:2})}); |] } diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs index 1b381b60..d40c9e56 100644 --- a/Yesod/Form/Nic.hs +++ b/Yesod/Form/Nic.hs @@ -31,7 +31,7 @@ nicHtmlFieldProfile = FieldProfile |] , fpWidget = \name -> do addScript' urlNicEdit - addJavaScript [$hamlet|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")});|] + addJavaScript [$jamlet|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")});|] } addScript' :: (y -> Either (Route y) String) -> GWidget sub y () diff --git a/Yesod/Hamlet.hs b/Yesod/Hamlet.hs index a30b5eba..18af6ba4 100644 --- a/Yesod/Hamlet.hs +++ b/Yesod/Hamlet.hs @@ -6,6 +6,8 @@ module Yesod.Hamlet ( -- * Hamlet library module Text.Hamlet + , jamlet + , camlet -- * Convert to something displayable , hamletToContent , hamletToRepHtml @@ -14,7 +16,9 @@ module Yesod.Hamlet ) where -import Text.Hamlet +import Text.Hamlet hiding (hamletFile) +import Text.Camlet +import Text.Jamlet import Yesod.Content import Yesod.Handler diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs index 1737b867..fc3e26c5 100644 --- a/Yesod/Widget.hs +++ b/Yesod/Widget.hs @@ -36,6 +36,8 @@ import Data.Monoid import Control.Monad.Trans.Writer import Control.Monad.Trans.State import Yesod.Hamlet (Hamlet, hamlet, PageContent (..), Html) +import Text.Camlet +import Text.Jamlet import Yesod.Handler (Route, GHandler) import Yesod.Yesod (Yesod, defaultLayout) import Yesod.Content (RepHtml (..)) @@ -43,6 +45,9 @@ import Control.Applicative (Applicative) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (lift) import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as S +import Text.Blaze (unsafeByteString) data Location url = Local url | Remote String deriving (Show, Eq) @@ -64,14 +69,10 @@ newtype Script url = Script { unScript :: Location url } newtype Stylesheet url = Stylesheet { unStylesheet :: Location url } deriving (Show, Eq) newtype Title = Title { unTitle :: Html () } -newtype Style url = Style (Maybe (Hamlet url)) - deriving Monoid newtype Head url = Head (Hamlet url) deriving Monoid newtype Body url = Body (Hamlet url) deriving Monoid -newtype JavaScript url = JavaScript (Maybe (Hamlet url)) - deriving Monoid -- | A generic widget, allowing specification of both the subsite and master -- site datatypes. This is basically a large 'WriterT' stack keeping track of @@ -81,8 +82,8 @@ newtype GWidget sub master a = GWidget ( WriterT (Last Title) ( WriterT (UniqueList (Script (Route master))) ( WriterT (UniqueList (Stylesheet (Route master))) ( - WriterT (Style (Route master)) ( - WriterT (JavaScript (Route master)) ( + WriterT (Maybe (Camlet (Route master))) ( + WriterT (Maybe (Jamlet (Route master))) ( WriterT (Head (Route master)) ( StateT Int ( GHandler sub master @@ -121,8 +122,8 @@ newIdent = GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift $ do return $ "w" ++ show i' -- | Add some raw CSS to the style tag. -addStyle :: Hamlet (Route master) -> GWidget sub master () -addStyle = GWidget . lift . lift . lift . lift . tell . Style . Just +addStyle :: Camlet (Route master) -> GWidget sub master () +addStyle = GWidget . lift . lift . lift . lift . tell . Just -- | Link to the specified local stylesheet. addStylesheet :: Route master -> GWidget sub master () @@ -149,9 +150,8 @@ addScriptRemote = GWidget . lift . lift . tell . toUnique . Script . Remote -- | Include raw Javascript in the page's script tag. -addJavaScript :: Hamlet (Route master) -> GWidget sub master () -addJavaScript = GWidget . lift . lift . lift . lift . lift. tell - . JavaScript . Just +addJavaScript :: Jamlet (Route master) -> GWidget sub master () +addJavaScript = GWidget . lift . lift . lift . lift . lift. tell . Just -- | Apply the default layout to the given widget. applyLayoutW :: (Eq (Route m), Yesod m) @@ -171,22 +171,30 @@ widgetToPageContent (GWidget w) = do Last mTitle), scripts'), stylesheets'), - Style style), - JavaScript jscript), + style), + jscript), Head head') = w' let title = maybe mempty unTitle mTitle let scripts = map (locationToHamlet . unScript) $ runUniqueList scripts' let stylesheets = map (locationToHamlet . unStylesheet) $ runUniqueList stylesheets' + -- FIXME the next functions can be optimized once blaze-html switches to + -- blaze-builder + let lbsToHtml = unsafeByteString . S.concat . L.toChunks + let celper :: Camlet url -> Hamlet url + celper c render = lbsToHtml $ renderCamlet render c + let jelper :: Jamlet url -> Hamlet url + jelper j render = lbsToHtml $ renderJamlet render j + let head'' = [$hamlet| $forall scripts s %script!src=^s^ $forall stylesheets s %link!rel=stylesheet!href=^s^ $maybe style s - %style ^s^ + %style ^celper.s^ $maybe jscript j - %script ^j^ + %script ^jelper.j^ ^head'^ |] return $ PageContent title head'' body diff --git a/hellowidget.hs b/hellowidget.hs index 7afe4641..7f66626c 100644 --- a/hellowidget.hs +++ b/hellowidget.hs @@ -2,6 +2,8 @@ import Yesod import Yesod.Widget import Yesod.Helpers.Static +import Yesod.Form.Jquery +import Yesod.Form.Nic import Control.Applicative data HW = HW { hwStatic :: Static } @@ -12,6 +14,8 @@ mkYesod "HW" [$parseRoutes| /autocomplete AutoCompleteR GET |] instance Yesod HW where approot _ = "" +instance YesodNic HW +instance YesodJquery HW wrapper h = [$hamlet| #wrapper ^h^ %footer Brought to you by Yesod Widgets™ @@ -19,7 +23,10 @@ wrapper h = [$hamlet| getRootR = applyLayoutW $ flip wrapWidget wrapper $ do i <- newIdent setTitle $ string "Hello Widgets" - addStyle [$hamlet|\#$i${color:red}|] + addStyle [$camlet| +#$i$ + color:red +|] addStylesheet $ StaticR $ StaticRoute ["style.css"] addStylesheetRemote "http://localhost:3000/static/style2.css" addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js" @@ -35,12 +42,13 @@ getRootR = applyLayoutW $ flip wrapWidget wrapper $ do addHead [$hamlet|%meta!keywords=haskell|] handleFormR = do - (res, form, enctype) <- runFormPost $ (,,,,,,,,) - <$> stringField (string "My Field") (string "Some tooltip info") Nothing - <*> stringField (string "Another field") (string "") (Just "some default text") - <*> intField (string "A number field") (string "some nums") (Just 5) - <*> jqueryDayField (string "A day field") (string "") Nothing - <*> timeField (string "A time field") (string "") Nothing + (res, form, enctype) <- runFormPost $ (,,,,,,,,,) + <$> stringField (FormFieldSettings "My Field" "Some tooltip info" Nothing Nothing) Nothing + <*> stringField (labelSettings "Another field") (Just "some default text") + <*> intField (FormFieldSettings "A number field" "some nums" Nothing Nothing) (Just 5) + <*> jqueryDayField (labelSettings "A day field") Nothing + <*> timeField (labelSettings "A time field") Nothing + <*> jqueryDayTimeField (labelSettings "A day/time field") Nothing <*> boolField FormFieldSettings { ffsLabel = "A checkbox" , ffsTooltip = "" @@ -48,16 +56,24 @@ handleFormR = do , ffsName = Nothing } (Just False) <*> jqueryAutocompleteField AutoCompleteR - (string "Autocomplete") (string "Try it!") Nothing - <*> nicHtmlField (string "HTML") (string "") + (FormFieldSettings "Autocomplete" "Try it!" Nothing Nothing) Nothing + <*> nicHtmlField (labelSettings "HTML") (Just $ string "You can put rich text here") - <*> maybeEmailField (string "An e-mail addres") mempty Nothing + <*> maybeEmailField (labelSettings "An e-mail addres") Nothing let mhtml = case res of - FormSuccess (_, _, _, _, _, _, _, x, _) -> Just x + FormSuccess (_, _, _, _, _, _, _, _, x, _) -> Just x _ -> Nothing applyLayoutW $ do - addStyle [$hamlet|\.tooltip{color:#666;font-style:italic}|] - addStyle [$hamlet|textarea.html{width:300px;height:150px};|] + addStyle [$camlet| +.tooltip + color:#666 + font-style:italic +|] + addStyle [$camlet| +textarea.html + width:300px + height:150px +|] wrapWidget (fieldsToTable form) $ \h -> [$hamlet| %form!method=post!enctype=$show.enctype$ %table diff --git a/yesod.cabal b/yesod.cabal index 0bdbfcb7..6d9678fe 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -32,7 +32,8 @@ library template-haskell >= 2.4 && < 2.5, web-routes >= 0.22 && < 0.23, web-routes-quasi >= 0.5 && < 0.6, - hamlet >= 0.4.1 && < 0.5, + hamlet >= 0.5.0 && < 0.6, + blaze-html >= 0.1.1 && < 0.2, transformers >= 0.2 && < 0.3, clientsession >= 0.4.0 && < 0.5, pureMD5 >= 1.1.0.0 && < 1.2,