Camlet and Jamlet

2010-08-08 10:48:32 +03:00 · 2010-08-08 10:48:32 +03:00 · a9a3730731
commit a9a3730731
parent ce25f03e79
6 changed files with 63 additions and 34 deletions
--- 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})});
 |]
    }
--- 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 ()
--- 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

--- 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
--- 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&trade;
@ -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
--- 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,