yesod 0.6.0.2 → 0.6.1
raw patch · 6 files changed
+74/−11 lines, 6 filesdep ~xss-sanitize
Dependency ranges changed: xss-sanitize
Files
- Yesod/Form/Fields.hs +58/−0
- Yesod/Form/Nic.hs +2/−2
- Yesod/Form/Profiles.hs +2/−2
- Yesod/Helpers/AtomFeed.hs +9/−0
- scaffold/devel-server_hs.cg +1/−5
- yesod.cabal +2/−2
Yesod/Form/Fields.hs view
@@ -16,6 +16,7 @@ , boolField , emailField , urlField+ , fileField -- ** Optional , maybeStringField , maybeTextareaField@@ -28,6 +29,7 @@ , maybeSelectField , maybeEmailField , maybeUrlField+ , maybeFileField -- * Inputs -- ** Required , stringInput@@ -44,6 +46,10 @@ import Yesod.Form.Core import Yesod.Form.Profiles+import Yesod.Request (FileInfo)+import Yesod.Widget (GWidget)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader (ask) import Data.Time (Day, TimeOfDay) import Text.Hamlet import Data.Monoid@@ -301,3 +307,55 @@ maybeHiddenField :: (IsForm f, FormType f ~ Maybe String) => FormFieldSettings -> Maybe (Maybe String) -> f maybeHiddenField = optionalFieldHelper hiddenFieldProfile++fileField :: (IsForm f, FormType f ~ FileInfo)+ => FormFieldSettings -> f+fileField ffs = toForm $ do+ env <- lift ask+ fenv <- lift $ lift ask+ let (FormFieldSettings label tooltip theId' name') = ffs+ name <- maybe newFormIdent return name'+ theId <- maybe newFormIdent return theId'+ let res =+ if null env && null fenv+ then FormMissing+ else case lookup name fenv of+ Nothing -> FormFailure ["File is required"]+ Just x -> FormSuccess x+ let fi = FieldInfo+ { fiLabel = string label+ , fiTooltip = tooltip+ , fiIdent = theId+ , fiInput = fileWidget theId name True+ , fiErrors = case res of+ FormFailure [x] -> Just $ string x+ _ -> Nothing+ , fiRequired = True+ }+ let res' = case res of+ FormFailure [e] -> FormFailure [label ++ ": " ++ e]+ _ -> res+ return (res', fi, Multipart)++maybeFileField :: (IsForm f, FormType f ~ Maybe FileInfo)+ => FormFieldSettings -> f+maybeFileField ffs = toForm $ do+ fenv <- lift $ lift ask+ let (FormFieldSettings label tooltip theId' name') = ffs+ name <- maybe newFormIdent return name'+ theId <- maybe newFormIdent return theId'+ let res = FormSuccess $ lookup name fenv+ let fi = FieldInfo+ { fiLabel = string label+ , fiTooltip = tooltip+ , fiIdent = theId+ , fiInput = fileWidget theId name False+ , fiErrors = Nothing+ , fiRequired = True+ }+ return (res, fi, Multipart)++fileWidget :: String -> String -> Bool -> GWidget s m ()+fileWidget theId name isReq = [$hamlet|+%input#$theId$!type=file!name=$name$!:isReq:required+|]
Yesod/Form/Nic.hs view
@@ -12,7 +12,7 @@ import Yesod.Form.Core import Yesod.Hamlet import Yesod.Widget-import Text.HTML.SanitizeXSS (sanitizeXSS)+import Text.HTML.SanitizeXSS (sanitizeBalance) import Yesod.Internal (lbsToChars) @@ -32,7 +32,7 @@ nicHtmlFieldProfile :: YesodNic y => FieldProfile sub y Html nicHtmlFieldProfile = FieldProfile- { fpParse = Right . preEscapedString . sanitizeXSS+ { fpParse = Right . preEscapedString . sanitizeBalance , fpRender = lbsToChars . renderHtml , fpWidget = \theId name val _isReq -> do addHtml [$hamlet|%textarea.html#$theId$!name=$name$ $val$|]
Yesod/Form/Profiles.hs view
@@ -24,7 +24,7 @@ import qualified Text.Email.Validate as Email import Network.URI (parseURI) import Database.Persist (PersistField)-import Text.HTML.SanitizeXSS (sanitizeXSS)+import Text.HTML.SanitizeXSS (sanitizeBalance) import Text.Blaze.Builder.Utf8 (writeChar) import Text.Blaze.Builder.Core (writeList, writeByteString)@@ -74,7 +74,7 @@ htmlFieldProfile :: FieldProfile sub y Html htmlFieldProfile = FieldProfile- { fpParse = Right . preEscapedString . sanitizeXSS+ { fpParse = Right . preEscapedString . sanitizeBalance , fpRender = lbsToChars . renderHtml , fpWidget = \theId name val _isReq -> addHamlet [$hamlet| %textarea.html#$theId$!name=$name$ $val$
Yesod/Helpers/AtomFeed.hs view
@@ -19,6 +19,7 @@ ( AtomFeed (..) , AtomFeedEntry (..) , atomFeed+ , atomLink , RepAtom (..) ) where @@ -68,4 +69,12 @@ %updated $formatW3.atomEntryUpdated.arg$ %title $atomEntryTitle.arg$ %content!type=html $cdata.atomEntryContent.arg$+|]++-- | Generates a link tag in the head of a widget.+atomLink :: Route m+ -> String -- ^ title+ -> GWidget s m ()+atomLink u title = addHamletHead [$hamlet|+%link!href=@u@!type="application/atom+xml"!rel="alternate"!title=$title$ |]
scaffold/devel-server_hs.cg view
@@ -9,11 +9,7 @@ , "You can view your app at http://localhost:3000/" , "" ]- _ <- forkIO $ run 3000 "Controller" "with~sitearg~"- [ "hamlet"- , "cassius"- , "julius"- ]+ _ <- forkIO $ run 3000 "Controller" "with~sitearg~" ["hamlet"] go where go = do
yesod.cabal view
@@ -1,5 +1,5 @@ name: yesod-version: 0.6.0.2+version: 0.6.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -44,7 +44,7 @@ , network >= 2.2.1.5 && < 2.3 , email-validate >= 0.2.5 && < 0.3 , web-routes >= 0.23 && < 0.24- , xss-sanitize >= 0.2 && < 0.3+ , xss-sanitize >= 0.2.3 && < 0.3 , data-default >= 0.2 && < 0.3 , failure >= 0.1 && < 0.2 , containers >= 0.2 && < 0.5