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

Major renaming of widget functions

Browse Source
This commit is contained in:
Michael Snoyman 2010-10-24 18:51:32 +02:00
parent b5622c4a71
commit 17cb10c312
7 changed files with 64 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Yesod/Form/Fields.hs
View File

@ -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

12
Yesod/Form/Jquery.hs
View File

@ -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})});
|]
}

4
Yesod/Form/Nic.hs
View File

@ -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 ()

20
Yesod/Form/Profiles.hs
View File

@ -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$
|]
}

8
Yesod/Helpers/Crud.hs
View File

@ -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$

67
Yesod/Widget.hs
View File

@ -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'.

2
Yesod/Yesod.hs
View File

@ -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