diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs index 79fb0c65..b59898b5 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -44,7 +44,6 @@ module Yesod.Form.Fields import Yesod.Form.Core import Yesod.Form.Profiles -import Yesod.Widget import Data.Time (Day, TimeOfDay) import Text.Hamlet import Data.Monoid @@ -121,7 +120,7 @@ boolField ffs orig = toForm $ do { fiLabel = string label , fiTooltip = tooltip , fiIdent = theId - , fiInput = addBody [$hamlet| + , fiInput = [$hamlet| %input#$theId$!type=checkbox!name=$name$!:val:checked |] , fiErrors = case res of @@ -175,7 +174,7 @@ selectField pairs ffs initial = toForm $ do { fiLabel = string label , fiTooltip = tooltip , fiIdent = theId - , fiInput = addBody input + , fiInput = input , fiErrors = case res of FormFailure [x] -> Just $ string x _ -> Nothing @@ -220,7 +219,7 @@ maybeSelectField pairs ffs initial' = toForm $ do { fiLabel = string label , fiTooltip = tooltip , fiIdent = theId - , fiInput = addBody input + , fiInput = input , fiErrors = case res of FormFailure [x] -> Just $ string x _ -> Nothing @@ -246,9 +245,7 @@ boolInput n = GForm $ do Just "" -> FormSuccess False Just "false" -> FormSuccess False Just _ -> FormSuccess True - let xml = addBody [$hamlet| -%input#$n$!type=checkbox!name=$n$ -|] + let xml = [$hamlet|%input#$n$!type=checkbox!name=$n$|] return (res, [xml], UrlEncoded) dayInput :: String -> FormInput sub master Day diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs index defb1754..90bbd7aa 100644 --- a/Yesod/Form/Jquery.hs +++ b/Yesod/Form/Jquery.hs @@ -74,13 +74,13 @@ jqueryDayFieldProfile jds = FieldProfile . readMay , fpRender = show , fpWidget = \theId name val isReq -> do - addBody [$hamlet| + addHtml [$hamlet| %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$ |] addScript' urlJqueryJs addScript' urlJqueryUiJs addStylesheet' urlJqueryUiCss - addJavascript [$julius| + addJulius [$julius| $(function(){$("#%theId%").datepicker({ dateFormat:'yy-mm-dd', changeMonth:%jsBool.jdsChangeMonth.jds%, @@ -132,14 +132,14 @@ jqueryDayTimeFieldProfile = FieldProfile { fpParse = parseUTCTime , fpRender = jqueryDayTimeUTCTime , fpWidget = \theId name val isReq -> do - addBody [$hamlet| + addHtml [$hamlet| %input#$theId$!name=$name$!:isReq:required!value=$val$ |] addScript' urlJqueryJs addScript' urlJqueryUiJs addScript' urlJqueryUiDateTimePicker addStylesheet' urlJqueryUiCss - addJavascript [$julius| + addJulius [$julius| $(function(){$("#%theId%").datetimepicker({dateFormat : "yyyy/mm/dd h:MM TT"})}); |] } @@ -176,13 +176,13 @@ jqueryAutocompleteFieldProfile src = FieldProfile { fpParse = Right , fpRender = id , fpWidget = \theId name val isReq -> do - addBody [$hamlet| + addHtml [$hamlet| %input.autocomplete#$theId$!name=$name$!type=text!:isReq:required!value=$val$ |] addScript' urlJqueryJs addScript' urlJqueryUiJs addStylesheet' urlJqueryUiCss - addJavascript [$julius| + addJulius [$julius| $(function(){$("#%theId%").autocomplete({source:"@src@",minLength:2})}); |] } diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs index a3256d45..328d36d2 100644 --- a/Yesod/Form/Nic.hs +++ b/Yesod/Form/Nic.hs @@ -35,9 +35,9 @@ nicHtmlFieldProfile = FieldProfile { fpParse = Right . preEscapedString . sanitizeXSS , fpRender = lbsToChars . renderHtml , fpWidget = \theId name val _isReq -> do - addBody [$hamlet|%textarea.html#$theId$!name=$name$ $val$|] + addHtml [$hamlet|%textarea.html#$theId$!name=$name$ $val$|] addScript' urlNicEdit - addJavascript [$julius|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("%theId%")});|] + addJulius [$julius|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("%theId%")});|] } addScript' :: (y -> Either (Route y) String) -> GWidget sub y () diff --git a/Yesod/Form/Profiles.hs b/Yesod/Form/Profiles.hs index 029260bb..ba9d3eec 100644 --- a/Yesod/Form/Profiles.hs +++ b/Yesod/Form/Profiles.hs @@ -35,7 +35,7 @@ intFieldProfile :: Integral i => FieldProfile sub y i intFieldProfile = FieldProfile { fpParse = maybe (Left "Invalid integer") Right . readMayI , fpRender = showI - , fpWidget = \theId name val isReq -> addBody [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet [$hamlet| %input#$theId$!name=$name$!type=number!:isReq:required!value=$val$ |] } @@ -49,7 +49,7 @@ doubleFieldProfile :: FieldProfile sub y Double doubleFieldProfile = FieldProfile { fpParse = maybe (Left "Invalid number") Right . readMay , fpRender = show - , fpWidget = \theId name val isReq -> addBody [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet [$hamlet| %input#$theId$!name=$name$!type=text!:isReq:required!value=$val$ |] } @@ -58,7 +58,7 @@ dayFieldProfile :: FieldProfile sub y Day dayFieldProfile = FieldProfile { fpParse = parseDate , fpRender = show - , fpWidget = \theId name val isReq -> addBody [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet [$hamlet| %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$ |] } @@ -67,7 +67,7 @@ timeFieldProfile :: FieldProfile sub y TimeOfDay timeFieldProfile = FieldProfile { fpParse = parseTime , fpRender = show - , fpWidget = \theId name val isReq -> addBody [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet [$hamlet| %input#$theId$!name=$name$!:isReq:required!value=$val$ |] } @@ -76,7 +76,7 @@ htmlFieldProfile :: FieldProfile sub y Html htmlFieldProfile = FieldProfile { fpParse = Right . preEscapedString . sanitizeXSS , fpRender = lbsToChars . renderHtml - , fpWidget = \theId name val _isReq -> addBody [$hamlet| + , fpWidget = \theId name val _isReq -> addHamlet [$hamlet| %textarea.html#$theId$!name=$name$ $val$ |] } @@ -102,7 +102,7 @@ textareaFieldProfile :: FieldProfile sub y Textarea textareaFieldProfile = FieldProfile { fpParse = Right . Textarea , fpRender = unTextarea - , fpWidget = \theId name val _isReq -> addBody [$hamlet| + , fpWidget = \theId name val _isReq -> addHamlet [$hamlet| %textarea#$theId$!name=$name$ $val$ |] } @@ -111,7 +111,7 @@ hiddenFieldProfile :: FieldProfile sub y String hiddenFieldProfile = FieldProfile { fpParse = Right , fpRender = id - , fpWidget = \theId name val _isReq -> addBody [$hamlet| + , fpWidget = \theId name val _isReq -> addHamlet [$hamlet| %input!type=hidden#$theId$!name=$name$!value=$val$ |] } @@ -120,7 +120,7 @@ stringFieldProfile :: FieldProfile sub y String stringFieldProfile = FieldProfile { fpParse = Right , fpRender = id - , fpWidget = \theId name val isReq -> addBody [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet [$hamlet| %input#$theId$!name=$name$!type=text!:isReq:required!value=$val$ |] } @@ -169,7 +169,7 @@ emailFieldProfile = FieldProfile then Right s else Left "Invalid e-mail address" , fpRender = id - , fpWidget = \theId name val isReq -> addBody [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet [$hamlet| %input#$theId$!name=$name$!type=email!:isReq:required!value=$val$ |] } @@ -180,7 +180,7 @@ urlFieldProfile = FieldProfile Nothing -> Left "Invalid URL" Just _ -> Right s , fpRender = id - , fpWidget = \theId name val isReq -> addBody [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet [$hamlet| %input#$theId$!name=$name$!type=url!:isReq:required!value=$val$ |] } diff --git a/Yesod/Helpers/Crud.hs b/Yesod/Helpers/Crud.hs index d08d1231..e04afc32 100644 --- a/Yesod/Helpers/Crud.hs +++ b/Yesod/Helpers/Crud.hs @@ -55,7 +55,7 @@ getCrudListR = do toMaster <- getRouteToMaster defaultLayout $ do setTitle "Items" - addBody [$hamlet| + addWidget [$hamlet| %h1 Items %ul $forall items item @@ -115,7 +115,7 @@ getCrudDeleteR s = do toMaster <- getRouteToMaster defaultLayout $ do setTitle "Confirm delete" - addBody [$hamlet| + addWidget [$hamlet| %form!method=post!action=@toMaster.CrudDeleteR.s@ %h1 Really delete? %p Do you really want to delete $itemTitle.item$? @@ -156,10 +156,8 @@ crudHelper title me isPost = do $ toSinglePiece eid _ -> return () defaultLayout $ do - wrapWidget form (wrapForm toMaster enctype) setTitle $ string title - where - wrapForm toMaster enctype form = [$hamlet| + addWidget [$hamlet| %p %a!href=@toMaster.CrudListR@ Return to list %h1 $title$ diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs index d89b2640..b9cbc69f 100644 --- a/Yesod/Widget.hs +++ b/Yesod/Widget.hs @@ -10,21 +10,27 @@ module Yesod.Widget GWidget (..) , liftHandler -- * Creating - , newIdent + -- ** Head of page , setTitle - , addStyle + , addHamletHead + , addHtmlHead + -- ** Body + , addHamlet + , addHtml + , addWidget + -- ** CSS + , addCassius , addStylesheet , addStylesheetRemote , addStylesheetEither + -- ** Javascript + , addJulius , addScript , addScriptRemote , addScriptEither - , addHead - , addBody - , addJavascript - -- * Manipulating - , wrapWidget + -- * Utilities , extractBody + , newIdent ) where import Data.Monoid @@ -76,9 +82,9 @@ instance HamletValue (GWidget s m ()) where GWidget' { runGWidget' :: GWidget s m a } type HamletUrl (GWidget s m ()) = Route m toHamletValue = runGWidget' - htmlToHamletMonad = GWidget' . addBody . const + htmlToHamletMonad = GWidget' . addHtml urlToHamletMonad url params = GWidget' $ - addBody $ \r -> preEscapedString (r url params) + addHamlet $ \r -> preEscapedString (r url params) fromHamletValue = GWidget' instance Monad (HamletMonad (GWidget s m ())) where return = GWidget' . return @@ -94,13 +100,26 @@ liftHandler = GWidget . lift . lift . lift . lift . lift . lift . lift . lift setTitle :: Html -> GWidget sub master () setTitle = GWidget . lift . tell . Last . Just . Title --- | Add some raw HTML to the head tag. -addHead :: Hamlet (Route master) -> GWidget sub master () -addHead = GWidget . lift . lift . lift . lift . lift . lift . tell . Head +-- | Add a 'Hamlet' to the head tag. +addHamletHead :: Hamlet (Route master) -> GWidget sub master () +addHamletHead = GWidget . lift . lift . lift . lift . lift . lift . tell . Head --- | Add some raw HTML to the body tag. -addBody :: Hamlet (Route master) -> GWidget sub master () -addBody = GWidget . tell . Body +-- | Add a 'Html' to the head tag. +addHtmlHead :: Html -> GWidget sub master () +addHtmlHead = GWidget . lift . lift . lift . lift . lift . lift . tell . Head . const + +-- | Add a 'Hamlet' to the body tag. +addHamlet :: Hamlet (Route master) -> GWidget sub master () +addHamlet = GWidget . tell . Body + +-- | Add a 'Html' to the body tag. +addHtml :: Html -> GWidget sub master () +addHtml = GWidget . tell . Body . const + +-- | Add another widget. This is defined as 'id', by can help with types, and +-- makes widget blocks look more consistent. +addWidget :: GWidget s m () -> GWidget s m () +addWidget = id -- | Get a unique identifier. newIdent :: GWidget sub master String @@ -111,8 +130,8 @@ newIdent = GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift $ do return $ "w" ++ show i' -- | Add some raw CSS to the style tag. -addStyle :: Cassius (Route master) -> GWidget sub master () -addStyle = GWidget . lift . lift . lift . lift . tell . Just +addCassius :: Cassius (Route master) -> GWidget sub master () +addCassius = GWidget . lift . lift . lift . lift . tell . Just -- | Link to the specified local stylesheet. addStylesheet :: Route master -> GWidget sub master () @@ -139,18 +158,8 @@ addScriptRemote = GWidget . lift . lift . tell . toUnique . Script . Remote -- | Include raw Javascript in the page's script tag. -addJavascript :: Julius (Route master) -> GWidget sub master () -addJavascript = GWidget . lift . lift . lift . lift . lift. tell . Just - --- | Modify the given 'GWidget' by wrapping the body tag HTML code with the --- given function. You might also consider using 'extractBody'. -wrapWidget :: GWidget s m a - -> (Hamlet (Route m) -> Hamlet (Route m)) - -> GWidget s m a -wrapWidget (GWidget w) wrap = - GWidget $ mapWriterT (fmap go) w - where - go (a, Body h) = (a, Body $ wrap h) +addJulius :: Julius (Route master) -> GWidget sub master () +addJulius = GWidget . lift . lift . lift . lift . lift. tell . Just -- | Pull out the HTML tag contents and return it. Useful for performing some -- manipulations. It can be easier to use this sometimes than 'wrapWidget'. diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index 4d848de1..c252c297 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -255,7 +255,7 @@ applyLayout' :: Yesod master -> GHandler sub master ChooseRep applyLayout' title body = fmap chooseRep $ defaultLayout $ do setTitle title - addBody body + addHamlet body -- | The default error handler for 'errorHandler'. defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep