yesod-form 1.6.7 → 1.7.9.3
raw patch · 26 files changed
Files
- ChangeLog.md +56/−0
- README.md +1/−1
- Yesod/Form/Bootstrap3.hs +7/−5
- Yesod/Form/Fields.hs +251/−56
- Yesod/Form/Functions.hs +7/−6
- Yesod/Form/I18n/Chinese.hs +4/−2
- Yesod/Form/I18n/Czech.hs +4/−2
- Yesod/Form/I18n/Dutch.hs +4/−2
- Yesod/Form/I18n/English.hs +4/−2
- Yesod/Form/I18n/French.hs +4/−2
- Yesod/Form/I18n/German.hs +4/−2
- Yesod/Form/I18n/Japanese.hs +4/−2
- Yesod/Form/I18n/Korean.hs +4/−2
- Yesod/Form/I18n/Norwegian.hs +4/−2
- Yesod/Form/I18n/Portuguese.hs +4/−2
- Yesod/Form/I18n/Romanian.hs +31/−0
- Yesod/Form/I18n/Russian.hs +4/−2
- Yesod/Form/I18n/Spanish.hs +3/−2
- Yesod/Form/I18n/Swedish.hs +4/−2
- Yesod/Form/Input.hs +3/−3
- Yesod/Form/Jquery.hs +5/−4
- Yesod/Form/MassInput.hs +4/−3
- Yesod/Form/Nic.hs +4/−3
- Yesod/Form/Option.hs +96/−0
- Yesod/Form/Types.hs +24/−14
- yesod-form.cabal +9/−6
ChangeLog.md view
@@ -1,5 +1,61 @@ # ChangeLog for yesod-form +## 1.7.9.3++* Support `yesod-core` 1.7++## 1.7.9.2++* Improve deprecation messages for `radioField` and `checkboxesField` [#1902](https://github.com/yesodweb/yesod/pull/1902)++## 1.7.9.1++* Set `base >= 4.11` for less CPP and imports [#1876](https://github.com/yesodweb/yesod/pull/1876)++## 1.7.9++* Added `checkboxesField'` for creating checkbox in more correct way than original `checkboxesField`+ Function `checkboxesField` marked as deprecated. [#1843](https://github.com/yesodweb/yesod/pull/1843)++## 1.7.8++* Added `radioField'` for creating radio button in more correct way than original `radioField`.+ Function `radioField` marked as deprecated. [#1842](https://github.com/yesodweb/yesod/pull/1842)++## 1.7.7++* Added `optionsFromList'` to create an OptionList from a List, using the PathPiece instance for the external value and+a custom function for the user-facing value. Also added `optionsEnum'` to create an OptionList from an enumeration+[#1828](https://github.com/yesodweb/yesod/pull/1828)++## 1.7.6++* Added `datetimeLocalField` for creating a html `<input type="datetime-local">` [#1817](https://github.com/yesodweb/yesod/pull/1817)++## 1.7.5++* Add Romanian translation [#1801](https://github.com/yesodweb/yesod/pull/1801)++## 1.7.4++* Added a `Monad AForm` instance only when `transformers` >= 0.6 [#1795](https://github.com/yesodweb/yesod/pull/1795)++## 1.7.3++* Fixed `radioField` according to Bootstrap 3 docs. [#1783](https://github.com/yesodweb/yesod/pull/1783)++## 1.7.2++* Added `withRadioField` and re-express `radioField` into that. [#1775](https://github.com/yesodweb/yesod/pull/1775)++## 1.7.1++* Added `colorField` for creating a html color field (`<input type="color">`) [#1748](https://github.com/yesodweb/yesod/pull/1748)++## 1.7.0++* Extended `OptionList` by `OptionListGrouped` and implemented grouped select fields (`<select>` with `<optgroup>`) [#1722](https://github.com/yesodweb/yesod/pull/1722)+ ## 1.6.7 * Added equivalent version of `mreqMsg` for `areq` and `wreq` correspondingly [#1628](https://github.com/yesodweb/yesod/pull/1628)
README.md view
@@ -3,7 +3,7 @@ Form handling for Yesod, in the same style as formlets. See [the forms chapter](http://www.yesodweb.com/book/forms) of the Yesod book. -This package provies a set of basic form inputs such as text, number, time,+This package provides a set of basic form inputs such as text, number, time, checkbox, select, textarea, and etc. via `Yesod.Form.Fields` module. Also, there is `Yesod.Form.Nic` module providing richtext field using Nic editor. However, this module is grandfathered now and Nic editor is not actively
Yesod/Form/Bootstrap3.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+ -- | Helper functions for creating forms when using <http://getbootstrap.com/ Bootstrap 3>. -- @@ -112,10 +114,10 @@ toOffset (ColLg columns) = "col-lg-offset-" ++ show columns addGO :: BootstrapGridOptions -> BootstrapGridOptions -> BootstrapGridOptions-addGO (ColXs a) (ColXs b) = ColXs (a+b)-addGO (ColSm a) (ColSm b) = ColSm (a+b)-addGO (ColMd a) (ColMd b) = ColMd (a+b)-addGO (ColLg a) (ColLg b) = ColLg (a+b)+addGO (ColXs a) (ColXs b) = ColXs (a + b)+addGO (ColSm a) (ColSm b) = ColSm (a + b)+addGO (ColMd a) (ColMd b) = ColMd (a + b)+addGO (ColLg a) (ColLg b) = ColLg (a + b) addGO a b | a > b = addGO b a addGO (ColXs a) other = addGO (ColSm a) other addGO (ColSm a) other = addGO (ColMd a) other
Yesod/Form/Fields.hs view
@@ -1,10 +1,13 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-}+ -- | Field functions allow you to easily create and validate forms, cleanly handling the uncertainty of parsing user input. -- -- When possible, the field functions use a specific input type (e.g. "number"), allowing supporting browsers to validate the input before form submission. Browsers can also improve usability with this information; for example, mobile browsers might present a specialized keyboard for an input of type "email" or "number".@@ -45,19 +48,27 @@ , selectFieldHelper , selectField , selectFieldList+ , selectFieldListGrouped , radioField+ , radioField' , radioFieldList+ , withRadioField , checkboxesField+ , checkboxesField' , checkboxesFieldList , multiSelectField , multiSelectFieldList , Option (..) , OptionList (..) , mkOptionList+ , mkOptionListGrouped , optionsPersist , optionsPersistKey , optionsPairs+ , optionsPairsGrouped , optionsEnum+ , colorField+ , datetimeLocalField ) where import Yesod.Form.Types@@ -68,7 +79,7 @@ #define ToHtml ToMarkup #define toHtml toMarkup #define preEscapedText preEscapedToMarkup-import Data.Time (Day, TimeOfDay(..))+import Data.Time (Day, TimeOfDay(..), LocalTime (LocalTime)) import qualified Text.Email.Validate as Email import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)@@ -80,7 +91,7 @@ import Database.Persist (Entity (..), SqlType (SqlString), PersistEntity, PersistQuery, PersistEntityBackend) #endif import Text.HTML.SanitizeXSS (sanitizeBalance)-import Control.Monad (when, unless)+import Control.Monad (when, unless, forM_) import Data.Either (partitionEithers) import Data.Maybe (listToMaybe, fromMaybe) @@ -92,7 +103,8 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Text as T ( Text, append, concat, cons, head- , intercalate, isPrefixOf, null, unpack, pack, splitOn+ , intercalate, isPrefixOf, null, unpack, pack+ , split, splitOn ) import qualified Data.Text as T (drop, dropWhile) import qualified Data.Text.Read@@ -101,7 +113,7 @@ import Yesod.Persist (selectList, Filter, SelectOpt, Key) import Control.Arrow ((&&&)) -import Control.Applicative ((<$>), (<|>))+import Control.Applicative ((<|>)) import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly) @@ -109,10 +121,12 @@ import Data.String (IsString) -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif +import Data.Char (isHexDigit)++{-# DEPRECATED radioField "This function seems to have a bug (label could not be found with byLabel algorithm). Use radioField' instead." #-}+{-# DEPRECATED checkboxesField "This function seems to have a bug (label could not be found with byLabel algorithm). Use checkboxesField' instead." #-}+ defaultFormMessage :: FormMessage -> Text defaultFormMessage = englishFormMessage @@ -169,20 +183,20 @@ timeField = timeFieldTypeTime -- | Creates an input with @type="time"@. <http://caniuse.com/#search=time%20input%20type Browsers not supporting this type> will fallback to a text field, and Yesod will parse the time as described in 'timeFieldTypeText'.--- +-- -- Add the @time@ package and import the "Data.Time.LocalTime" module to use this function. ----- Since 1.4.2-timeFieldTypeTime :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay +-- @since 1.4.2+timeFieldTypeTime :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay timeFieldTypeTime = timeFieldOfType "time" -- | Creates an input with @type="text"@, parsing the time from an [H]H:MM[:SS] format, with an optional AM or PM (if not given, AM is assumed for compatibility with the 24 hour clock system). -- -- This function exists for backwards compatibility with the old implementation of 'timeField', which used to use @type="text"@. Consider using 'timeField' or 'timeFieldTypeTime' for improved UX and validation from the browser.--- +-- -- Add the @time@ package and import the "Data.Time.LocalTime" module to use this function. ----- Since 1.4.2+-- @since 1.4.2 timeFieldTypeText :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay timeFieldTypeText = timeFieldOfType "text" @@ -215,7 +229,7 @@ where showVal = either id (pack . renderHtml) -- | A newtype wrapper around a 'Text' whose 'ToMarkup' instance converts newlines to HTML @\<br>@ tags.--- +-- -- (When text is entered into a @\<textarea>@, newline characters are used to separate lines. -- If this text is then placed verbatim into HTML, the lines won't be separated, thus the need for replacing with @\<br>@ tags). -- If you don't need this functionality, simply use 'unTextarea' to access the raw text.@@ -329,7 +343,7 @@ where hour = do x <- digit- y <- (return Control.Applicative.<$> digit) <|> return []+ y <- (return <$> digit) <|> return [] let xy = x : y let i = read xy if i < 0 || i >= 24@@ -344,7 +358,7 @@ if i < 0 || i >= 60 then fail $ show $ msg $ pack xy else return $ fromIntegral (i :: Int)- + -- | Creates an input with @type="email"@. Yesod will validate the email's correctness according to RFC5322 and canonicalize it by removing comments and whitespace (see "Text.Email.Validate"). emailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text emailField = Field@@ -362,7 +376,7 @@ -- | Creates an input with @type="email"@ with the <http://w3c.github.io/html/sec-forms.html#the-multiple-attribute multiple> attribute; browsers might implement this as taking a comma separated list of emails. Each email address is validated as described in 'emailField'. ----- Since 1.3.7+-- @since 1.3.7 multiEmailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m [Text] multiEmailField = Field { fieldParse = parseHelper $@@ -427,8 +441,16 @@ -> Field (HandlerFor site) a selectFieldList = selectField . optionsPairs --- | Creates a @\<select>@ tag for selecting one option. Example usage:+-- | Creates a @\<select>@ tag with @\<optgroup>@s for selecting one option. --+-- @since 1.7.0+selectFieldListGrouped :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)+ => [(msg, [(msg, a)])]+ -> Field (HandlerFor site) a+selectFieldListGrouped = selectField . optionsPairsGrouped++-- | Creates a @\<select>@ tag with optional @\<optgroup>@s for selecting one option. Example usage:+-- -- > areq (selectField $ optionsPairs [(MsgValue1, "value1"),(MsgValue2, "value2")]) "Which value?" Nothing selectField :: (Eq a, RenderMessage site FormMessage) => HandlerFor site (OptionList a)@@ -446,6 +468,9 @@ $newline never <option value=#{value} :isSel:selected>#{text} |]) -- inside+ (Just $ \label -> [whamlet|+<optgroup label=#{label}>+|]) -- group label -- | Creates a @\<select>@ tag for selecting multiple options. multiSelectFieldList :: (Eq a, RenderMessage site msg)@@ -508,35 +533,104 @@ #{optionDisplay opt} |] }++-- | Creates an input with @type="checkbox"@ for selecting multiple options.+checkboxesField' :: Eq a+ => HandlerFor site (OptionList a)+ -> Field (HandlerFor site) [a]+checkboxesField' ioptlist = (multiSelectField ioptlist)+ { fieldView =+ \theId name attrs val _isReq -> do+ opts <- olOptions <$> handlerToWidget ioptlist+ let optselected (Left _) _ = False+ optselected (Right vals) opt = optionInternalValue opt `elem` vals+ [whamlet|+ <span ##{theId}>+ $forall opt <- opts+ <input id=#{theId}-#{optionExternalValue opt} type=checkbox name=#{name} value=#{optionExternalValue opt} *{attrs} :optselected val opt:checked>+ <label for=#{theId}-#{optionExternalValue opt}>+ #{optionDisplay opt}+ |]+ }++ -- | Creates an input with @type="radio"@ for selecting one option. radioField :: (Eq a, RenderMessage site FormMessage) => HandlerFor site (OptionList a) -> Field (HandlerFor site) a-radioField = selectFieldHelper- (\theId _name _attrs inside -> [whamlet|+radioField = withRadioField+ (\theId optionWidget -> [whamlet| $newline never-<div ##{theId}>^{inside}+<div .radio>+ <label for=#{theId}-none>+ <div>+ ^{optionWidget}+ _{MsgSelectNone} |])- (\theId name isSel -> [whamlet|+ (\theId value _isSel text optionWidget -> [whamlet| $newline never-<label .radio for=#{theId}-none>- <div>- <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>- _{MsgSelectNone}+<div .radio>+ <label for=#{theId}-#{value}>+ <div>+ ^{optionWidget}+ \#{text} |])- (\theId name attrs value isSel text -> [whamlet|+++-- | Creates an input with @type="radio"@ for selecting one option.+--+-- @since 1.7.8+radioField' :: (Eq a, RenderMessage site FormMessage)+ => HandlerFor site (OptionList a)+ -> Field (HandlerFor site) a+radioField' = withRadioField+ (\theId optionWidget -> [whamlet| $newline never-<label .radio for=#{theId}-#{value}>- <div>- <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>- \#{text}+<.radio>+ ^{optionWidget}+ <label for=#{theId}-none>+ _{MsgSelectNone} |])+ (\theId value _isSel text optionWidget -> [whamlet|+$newline never+<.radio>+ ^{optionWidget}+ <label for=#{theId}-#{value}>+ \#{text}+|]) +-- | Allows the user to place the option radio widget somewhere in+-- the template.+-- For example: If you want a table of radio options to select.+-- 'radioField' is an example on how to use this function.+--+-- @since 1.7.2+withRadioField :: (Eq a, RenderMessage site FormMessage)+ => (Text -> WidgetFor site ()-> WidgetFor site ()) -- ^ nothing case for mopt+ -> (Text -> Text -> Bool -> Text -> WidgetFor site () -> WidgetFor site ()) -- ^ cases for values+ -> HandlerFor site (OptionList a)+ -> Field (HandlerFor site) a+withRadioField nothingFun optFun =+ selectFieldHelper outside onOpt inside Nothing+ where+ outside theId _name _attrs inside' = [whamlet|+$newline never+<div ##{theId}>^{inside'}+|]+ onOpt theId name isSel = nothingFun theId $ [whamlet|+$newline never+<input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>+|]+ inside theId name attrs value isSel display =+ optFun theId value isSel display [whamlet|+<input id=#{theId}-#{(value)} type=radio name=#{name} value=#{(value)} :isSel:checked *{attrs}>+|]+ -- | Creates a group of radio buttons to answer the question given in the message. Radio buttons are used to allow differentiating between an empty response (@Nothing@) and a no response (@Just False@). Consider using the simpler 'checkBoxField' if you don't need to make this distinction. -- -- If this field is optional, the first radio button is labeled "\<None>", the second \"Yes" and the third \"No". ----- If this field is required, the first radio button is labeled \"Yes" and the second \"No". +-- If this field is required, the first radio button is labeled \"Yes" and the second \"No". -- -- (Exact label titles will depend on localization). boolField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool@@ -570,7 +664,7 @@ t -> Left $ SomeMessage $ MsgInvalidBool t showVal = either (\_ -> False) --- | Creates an input with @type="checkbox"@. +-- | Creates an input with @type="checkbox"@. -- While the default @'boolField'@ implements a radio button so you -- can differentiate between an empty response (@Nothing@) and a no -- response (@Just False@), this simpler checkbox field returns an empty@@ -598,15 +692,31 @@ showVal = either (\_ -> False) -- | A structure holding a list of options. Typically you can use a convenience function like 'mkOptionList' or 'optionsPairs' instead of creating this directly.-data OptionList a = OptionList+--+-- Extended by 'OptionListGrouped' in 1.7.0.+data OptionList a+ = OptionList { olOptions :: [Option a] , olReadExternal :: Text -> Maybe a -- ^ A function mapping from the form's value ('optionExternalValue') to the selected Haskell value ('optionInternalValue'). }+ | OptionListGrouped+ { olOptionsGrouped :: [(Text, [Option a])]+ , olReadExternalGrouped :: Text -> Maybe a -- ^ A function mapping from the form's value ('optionExternalValue') to the selected Haskell value ('optionInternalValue').+ } --- | Since 1.4.6+-- | Convert grouped 'OptionList' to a normal one.+--+-- @since 1.7.0+flattenOptionList :: OptionList a -> OptionList a+flattenOptionList (OptionListGrouped os re) = OptionList (concatMap snd os) re+flattenOptionList ol = ol++-- | @since 1.4.6 instance Functor OptionList where- fmap f (OptionList options readExternal) = + fmap f (OptionList options readExternal) = OptionList ((fmap.fmap) f options) (fmap f . readExternal)+ fmap f (OptionListGrouped options readExternal) =+ OptionListGrouped (map (\(g, os) -> (g, (fmap.fmap) f os)) options) (fmap f . readExternal) -- | Creates an 'OptionList', using a 'Map' to implement the 'olReadExternal' function. mkOptionList :: [Option a] -> OptionList a@@ -615,13 +725,22 @@ , olReadExternal = flip Map.lookup $ Map.fromList $ map (optionExternalValue &&& optionInternalValue) os } +-- | Creates an 'OptionList', using a 'Map' to implement the 'olReadExternalGrouped' function.+--+-- @since 1.7.0+mkOptionListGrouped :: [(Text, [Option a])] -> OptionList a+mkOptionListGrouped os = OptionListGrouped+ { olOptionsGrouped = os+ , olReadExternalGrouped = flip Map.lookup $ Map.fromList $ map (optionExternalValue &&& optionInternalValue) $ concatMap snd os+ }+ data Option a = Option { optionDisplay :: Text -- ^ The user-facing label. , optionInternalValue :: a -- ^ The Haskell value being selected. , optionExternalValue :: Text -- ^ The representation of this value stored in the form. } --- | Since 1.4.6+-- | @since 1.4.6 instance Functor Option where fmap f (Option display internal external) = Option display (f internal) external @@ -637,6 +756,30 @@ } return $ mkOptionList (zipWith mkOption [1 :: Int ..] opts) +-- | Creates an 'OptionList' from a list of (display-value, internal value) pairs.+--+-- @since 1.7.0+optionsPairsGrouped+ :: forall m msg a. (MonadHandler m, RenderMessage (HandlerSite m) msg)+ => [(msg, [(msg, a)])] -> m (OptionList a)+optionsPairsGrouped opts = do+ mr <- getMessageRender+ let mkOption (external, (display, internal)) =+ Option { optionDisplay = mr display+ , optionInternalValue = internal+ , optionExternalValue = pack $ show external+ }+ opts' = enumerateSublists opts :: [(msg, [(Int, (msg, a))])]+ opts'' = map (\(x, ys) -> (mr x, map mkOption ys)) opts'+ return $ mkOptionListGrouped opts''++-- | Helper to enumerate sublists with one consecutive index.+enumerateSublists :: forall a b. [(a, [b])] -> [(a, [(Int, b)])]+enumerateSublists xss =+ let yss :: [(Int, (a, [b]))]+ yss = snd $ foldl (\(i, res) xs -> (i + (length.snd) xs, res ++ [(i, xs)])) (1, []) xss+ in map (\(i, (x, ys)) -> (x, zip [i :: Int ..] ys)) yss+ -- | Creates an 'OptionList' from an 'Enum', using its 'Show' instance for the user-facing value. optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a) optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]@@ -692,7 +835,7 @@ -- | An alternative to 'optionsPersist' which returns just the 'Key' instead of -- the entire 'Entity'. ----- Since 1.3.2+-- @since 1.3.2 #if MIN_VERSION_persistent(2,5,0) optionsPersistKey :: (YesodPersist site@@ -731,7 +874,7 @@ }) pairs -- |--- A helper function for constucting 'selectField's. You may want to use this when you define your custom 'selectField's or 'radioField's.+-- A helper function for constucting 'selectField's with optional option groups. You may want to use this when you define your custom 'selectField's or 'radioField's. -- -- @since 1.6.2 selectFieldHelper@@ -739,23 +882,26 @@ => (Text -> Text -> [(Text, Text)] -> WidgetFor site () -> WidgetFor site ()) -- ^ Outermost part of the field -> (Text -> Text -> Bool -> WidgetFor site ()) -- ^ An option for None if the field is optional -> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> WidgetFor site ()) -- ^ Other options+ -> (Maybe (Text -> WidgetFor site ())) -- ^ Group headers placed inbetween options -> HandlerFor site (OptionList a) -> Field (HandlerFor site) a-selectFieldHelper outside onOpt inside opts' = Field+selectFieldHelper outside onOpt inside grpHdr opts' = Field { fieldParse = \x _ -> do- opts <- opts'+ opts <- fmap flattenOptionList opts' return $ selectParser opts x , fieldView = \theId name attrs val isReq -> do- opts <- fmap olOptions $ handlerToWidget opts' outside theId name attrs $ do- unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts- flip mapM_ opts $ \opt -> inside- theId- name- ((if isReq then (("required", "required"):) else id) attrs)- (optionExternalValue opt)- ((render opts val) == optionExternalValue opt)- (optionDisplay opt)+ optsFlat <- fmap (olOptions.flattenOptionList) $ handlerToWidget opts'+ unless isReq $ onOpt theId name $ render optsFlat val `notElem` map optionExternalValue optsFlat+ opts'' <- handlerToWidget opts'+ case opts'' of+ OptionList{} -> constructOptions theId name attrs val isReq optsFlat+ OptionListGrouped{olOptionsGrouped=grps} -> do+ forM_ grps $ \(grp, opts) -> do+ case grpHdr of+ Just hdr -> hdr grp+ Nothing -> return ()+ constructOptions theId name attrs val isReq opts , fieldEnctype = UrlEncoded } where@@ -768,6 +914,14 @@ x -> case olReadExternal opts x of Nothing -> Left $ SomeMessage $ MsgInvalidEntry x Just y -> Right $ Just y+ constructOptions theId name attrs val isReq opts =+ forM_ opts $ \opt -> inside+ theId+ name+ ((if isReq then (("required", "required"):) else id) attrs)+ (optionExternalValue opt)+ (render opts val == optionExternalValue opt)+ (optionDisplay opt) -- | Creates an input with @type="file"@. fileField :: Monad m@@ -864,11 +1018,52 @@ then "-0." `T.append` (T.drop 2 t1) else t1 - where t1 = T.dropWhile ((==) ' ') t0+ where t1 = T.dropWhile (== ' ') t0 -- $optionsOverview -- These functions create inputs where one or more options can be selected from a list.--- +-- -- The basic datastructure used is an 'Option', which combines a user-facing display value, the internal Haskell value being selected, and an external 'Text' stored as the @value@ in the form (used to map back to the internal value). A list of these, together with a function mapping from an external value back to a Haskell value, form an 'OptionList', which several of these functions take as an argument.--- +-- -- Typically, you won't need to create an 'OptionList' directly and can instead make one with functions like 'optionsPairs' or 'optionsEnum'. Alternatively, you can use functions like 'selectFieldList', which use their @[(msg, a)]@ parameter to create an 'OptionList' themselves.++-- | Creates an input with @type="color"@.+-- The input value must be provided in hexadecimal format #rrggbb.+--+-- @since 1.7.1+colorField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text+colorField = Field+ { fieldParse = parseHelper $ \s ->+ if isHexColor $ unpack s then Right s+ else Left $ MsgInvalidHexColorFormat s+ , fieldView = \theId name attrs val _ -> [whamlet|+$newline never+<input ##{theId} name=#{name} *{attrs} type=color value=#{either id id val}>+|]+ , fieldEnctype = UrlEncoded+ }+ where+ isHexColor :: String -> Bool+ isHexColor ['#',a,b,c,d,e,f] = all isHexDigit [a,b,c,d,e,f]+ isHexColor _ = False++-- | Creates an input with @type="datetime-local"@.+-- The input value must be provided in YYYY-MM-DD(T| )HH:MM[:SS] format.+--+-- @since 1.7.6+datetimeLocalField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m LocalTime+datetimeLocalField = Field+ { fieldParse = parseHelper $ \s -> case T.split (\c -> (c == 'T') || (c == ' ')) s of+ [d,t] -> do+ day <- parseDate $ unpack d+ time <- parseTime t+ Right $ LocalTime day time+ _ -> Left $ MsgInvalidDatetimeFormat s+ , fieldView = \theId name attrs val isReq -> [whamlet|+$newline never+<input type=datetime-local ##{theId} name=#{name} value=#{showVal val} *{attrs} :isReq:required>+|]+ , fieldEnctype = UrlEncoded+ }+ where+ showVal = either id (pack . show)
Yesod/Form/Functions.hs view
@@ -1,10 +1,12 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-}+ module Yesod.Form.Functions ( -- * Running in MForm monad newFormIdent@@ -72,7 +74,6 @@ #define toHtml toMarkup import Yesod.Core import Network.Wai (requestMethod)-import Data.Monoid (mempty, (<>)) import Data.Maybe (listToMaybe, fromMaybe) import qualified Data.Map as Map import qualified Data.Text.Encoding as TE@@ -328,7 +329,7 @@ let tokenKey = defaultCsrfParamName let token = case reqToken req of- Nothing -> Data.Monoid.mempty+ Nothing -> mempty Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|] m <- getYesod langs <- languages
Yesod/Form/I18n/Chinese.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Chinese where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) chineseFormMessage :: FormMessage -> Text-chineseFormMessage (MsgInvalidInteger t) = "无效的整数: " `Data.Monoid.mappend` t+chineseFormMessage (MsgInvalidInteger t) = "无效的整数: " `mappend` t chineseFormMessage (MsgInvalidNumber t) = "无效的数字: " `mappend` t chineseFormMessage (MsgInvalidEntry t) = "无效的条目: " `mappend` t chineseFormMessage MsgInvalidTimeFormat = "无效的时间, 必须符合HH:MM[:SS]格式"@@ -24,3 +24,5 @@ chineseFormMessage MsgBoolYes = "是" chineseFormMessage MsgBoolNo = "否" chineseFormMessage MsgDelete = "删除?"+chineseFormMessage (MsgInvalidHexColorFormat t) = "颜色无效，必须为 #rrggbb 十六进制格式: " `mappend` t+chineseFormMessage (MsgInvalidDatetimeFormat t) = "日期時間無效，必須採用 YYYY-MM-DD(T| )HH:MM[:SS] 格式： " `mappend` t
Yesod/Form/I18n/Czech.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Czech where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) czechFormMessage :: FormMessage -> Text-czechFormMessage (MsgInvalidInteger t) = "Neplatné celé číslo: " `Data.Monoid.mappend` t+czechFormMessage (MsgInvalidInteger t) = "Neplatné celé číslo: " `mappend` t czechFormMessage (MsgInvalidNumber t) = "Neplatné číslo: " `mappend` t czechFormMessage (MsgInvalidEntry t) = "Neplatná položka: " `mappend` t czechFormMessage MsgInvalidTimeFormat = "Neplatný čas, musí být ve formátu HH:MM[:SS]"@@ -24,3 +24,5 @@ czechFormMessage MsgBoolYes = "Ano" czechFormMessage MsgBoolNo = "Ne" czechFormMessage MsgDelete = "Smazat?"+czechFormMessage (MsgInvalidHexColorFormat t) = "Neplatná barva, musí být v #rrggbb hexadecimálním formátu: " `mappend` t+czechFormMessage (MsgInvalidDatetimeFormat t) = "Neplatné datum a čas, musí být ve formátu YYYY-MM-DD(T| )HH:MM[:SS]: " `mappend` t
Yesod/Form/I18n/Dutch.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Dutch where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) dutchFormMessage :: FormMessage -> Text-dutchFormMessage (MsgInvalidInteger t) = "Ongeldig aantal: " `Data.Monoid.mappend` t+dutchFormMessage (MsgInvalidInteger t) = "Ongeldig aantal: " `mappend` t dutchFormMessage (MsgInvalidNumber t) = "Ongeldig getal: " `mappend` t dutchFormMessage (MsgInvalidEntry t) = "Ongeldige invoer: " `mappend` t dutchFormMessage MsgInvalidTimeFormat = "Ongeldige tijd, het juiste formaat is (UU:MM[:SS])"@@ -24,3 +24,5 @@ dutchFormMessage MsgBoolYes = "Ja" dutchFormMessage MsgBoolNo = "Nee" dutchFormMessage MsgDelete = "Verwijderen?"+dutchFormMessage (MsgInvalidHexColorFormat t) = "Ongeldige kleur, moet de hexadecimale indeling #rrggbb hebben: " `mappend` t+dutchFormMessage (MsgInvalidDatetimeFormat t) = "Ongeldige datum/tijd, moet de indeling JJJJ-MM-DD(T| )UU:MM[:SS] hebben: " `mappend` t
Yesod/Form/I18n/English.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.English where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) englishFormMessage :: FormMessage -> Text-englishFormMessage (MsgInvalidInteger t) = "Invalid integer: " `Data.Monoid.mappend` t+englishFormMessage (MsgInvalidInteger t) = "Invalid integer: " `mappend` t englishFormMessage (MsgInvalidNumber t) = "Invalid number: " `mappend` t englishFormMessage (MsgInvalidEntry t) = "Invalid entry: " `mappend` t englishFormMessage MsgInvalidTimeFormat = "Invalid time, must be in HH:MM[:SS] format"@@ -24,3 +24,5 @@ englishFormMessage MsgBoolYes = "Yes" englishFormMessage MsgBoolNo = "No" englishFormMessage MsgDelete = "Delete?"+englishFormMessage (MsgInvalidHexColorFormat t) = "Invalid color, must be in #rrggbb hexadecimal format: " `mappend` t+englishFormMessage (MsgInvalidDatetimeFormat t) = "Invalid datetime, must be in YYYY-MM-DD(T| )HH:MM[:SS] format: " `mappend` t
Yesod/Form/I18n/French.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.French (frenchFormMessage) where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) frenchFormMessage :: FormMessage -> Text-frenchFormMessage (MsgInvalidInteger t) = "Entier invalide : " `Data.Monoid.mappend` t+frenchFormMessage (MsgInvalidInteger t) = "Entier invalide : " `mappend` t frenchFormMessage (MsgInvalidNumber t) = "Nombre invalide : " `mappend` t frenchFormMessage (MsgInvalidEntry t) = "Entrée invalide : " `mappend` t frenchFormMessage MsgInvalidTimeFormat = "Heure invalide (elle doit être au format HH:MM ou HH:MM:SS"@@ -24,3 +24,5 @@ frenchFormMessage MsgBoolYes = "Oui" frenchFormMessage MsgBoolNo = "Non" frenchFormMessage MsgDelete = "Détruire ?"+frenchFormMessage (MsgInvalidHexColorFormat t) = "Couleur non valide. doit être au format hexadécimal #rrggbb : " `mappend` t+frenchFormMessage (MsgInvalidDatetimeFormat t) = "Date/heure non valide. doit être au format AAAA-MM-JJ(T| )HH:MM[:SS] : " `mappend` t
Yesod/Form/I18n/German.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.German where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) germanFormMessage :: FormMessage -> Text-germanFormMessage (MsgInvalidInteger t) = "Ungültige Ganzzahl: " `Data.Monoid.mappend` t+germanFormMessage (MsgInvalidInteger t) = "Ungültige Ganzzahl: " `mappend` t germanFormMessage (MsgInvalidNumber t) = "Ungültige Zahl: " `mappend` t germanFormMessage (MsgInvalidEntry t) = "Ungültiger Eintrag: " `mappend` t germanFormMessage MsgInvalidTimeFormat = "Ungültiges Zeitformat, HH:MM[:SS] Format erwartet"@@ -24,3 +24,5 @@ germanFormMessage MsgBoolYes = "Ja" germanFormMessage MsgBoolNo = "Nein" germanFormMessage MsgDelete = "Löschen?"+germanFormMessage (MsgInvalidHexColorFormat t) = "Ungültige Farbe, muss im Hexadezimalformat #rrggbb vorliegen: " `mappend` t+germanFormMessage (MsgInvalidDatetimeFormat t) = "Ungültige Datums- und Uhrzeitangabe, muss im Format YYYY-MM-DD(T| )HH:MM[:SS] vorliegen: " `mappend` t
Yesod/Form/I18n/Japanese.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Japanese where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) japaneseFormMessage :: FormMessage -> Text-japaneseFormMessage (MsgInvalidInteger t) = "無効な整数です: " `Data.Monoid.mappend` t+japaneseFormMessage (MsgInvalidInteger t) = "無効な整数です: " `mappend` t japaneseFormMessage (MsgInvalidNumber t) = "無効な数値です: " `mappend` t japaneseFormMessage (MsgInvalidEntry t) = "無効な入力です: " `mappend` t japaneseFormMessage MsgInvalidTimeFormat = "無効な時刻です。HH:MM[:SS]フォーマットで入力してください"@@ -24,3 +24,5 @@ japaneseFormMessage MsgBoolYes = "はい" japaneseFormMessage MsgBoolNo = "いいえ" japaneseFormMessage MsgDelete = "削除しますか?"+japaneseFormMessage (MsgInvalidHexColorFormat t) = "無効な色。＃rrggbb16進形式である必要があります: " `mappend` t+japaneseFormMessage (MsgInvalidDatetimeFormat t) = "無効な日時です。YYYY-MM-DD(T| )HH:MM[:SS] 形式である必要があります: " `mappend` t
Yesod/Form/I18n/Korean.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Korean where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) koreanFormMessage :: FormMessage -> Text-koreanFormMessage (MsgInvalidInteger t) = "잘못된 정수입니다: " `Data.Monoid.mappend` t+koreanFormMessage (MsgInvalidInteger t) = "잘못된 정수입니다: " `mappend` t koreanFormMessage (MsgInvalidNumber t) = "잘못된 숫자입니다: " `mappend` t koreanFormMessage (MsgInvalidEntry t) = "잘못된 입력입니다: " `mappend` t koreanFormMessage MsgInvalidTimeFormat = "잘못된 시간입니다. HH:MM[:SS] 형태로 입력하세요"@@ -24,3 +24,5 @@ koreanFormMessage MsgBoolYes = "예" koreanFormMessage MsgBoolNo = "아니오" koreanFormMessage MsgDelete = "삭제하시겠습니까?"+koreanFormMessage (MsgInvalidHexColorFormat t) = "색상이 잘못되었습니다. #rrggbb 16진수 형식이어야 합니다.: " `mappend` t+koreanFormMessage (MsgInvalidDatetimeFormat t) = "날짜/시간이 잘못되었습니다. YYYY-MM-DD(T| )HH:MM[:SS] 형식이어야 합니다.: " `mappend` t
Yesod/Form/I18n/Norwegian.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Norwegian where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) norwegianBokmålFormMessage :: FormMessage -> Text-norwegianBokmålFormMessage (MsgInvalidInteger t) = "Ugyldig antall: " `Data.Monoid.mappend` t+norwegianBokmålFormMessage (MsgInvalidInteger t) = "Ugyldig antall: " `mappend` t norwegianBokmålFormMessage (MsgInvalidNumber t) = "Ugyldig nummer: " `mappend` t norwegianBokmålFormMessage (MsgInvalidEntry t) = "Ugyldig oppføring: " `mappend` t norwegianBokmålFormMessage MsgInvalidTimeFormat = "Ugyldig klokkeslett, må være i formatet HH:MM[:SS]"@@ -24,3 +24,5 @@ norwegianBokmålFormMessage MsgBoolNo = "Nei" norwegianBokmålFormMessage MsgDelete = "Slette?" norwegianBokmålFormMessage MsgCsrfWarning = "Som beskyttelse mot «cross-site request forgery»-angrep, vennligst bekreft innsendt skjema."+norwegianBokmålFormMessage (MsgInvalidHexColorFormat t) = "Ugyldig farge, må være i #rrggbb heksadesimalt format: " `mappend` t+norwegianBokmålFormMessage (MsgInvalidDatetimeFormat t) = "Ugyldig datoklokkeslett, må være i formatet ÅÅÅÅ-MM-DD(T| )HH:MM[:SS]:" `mappend` t
Yesod/Form/I18n/Portuguese.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Portuguese where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) portugueseFormMessage :: FormMessage -> Text-portugueseFormMessage (MsgInvalidInteger t) = "Número inteiro inválido: " `Data.Monoid.mappend` t+portugueseFormMessage (MsgInvalidInteger t) = "Número inteiro inválido: " `mappend` t portugueseFormMessage (MsgInvalidNumber t) = "Número inválido: " `mappend` t portugueseFormMessage (MsgInvalidEntry t) = "Entrada inválida: " `mappend` t portugueseFormMessage MsgInvalidTimeFormat = "Hora inválida, deve estar no formato HH:MM[:SS]"@@ -24,3 +24,5 @@ portugueseFormMessage MsgBoolYes = "Sim" portugueseFormMessage MsgBoolNo = "Não" portugueseFormMessage MsgDelete = "Remover?"+portugueseFormMessage (MsgInvalidHexColorFormat t) = "Cor inválida, deve estar no formato #rrggbb hexadecimal: " `mappend` t+portugueseFormMessage (MsgInvalidDatetimeFormat t) = "Data e hora inválida, deve estar no formato AAAA-MM-DD(T| )HH:MM[:SS]: " `mappend` t
+ Yesod/Form/I18n/Romanian.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++module Yesod.Form.I18n.Romanian where++import Yesod.Form.Types (FormMessage (..))+import Data.Text (Text)++-- | Romanian translation+--+-- @since 1.7.5+romanianFormMessage :: FormMessage -> Text+romanianFormMessage (MsgInvalidInteger t) = "Număr întreg nevalid: " `mappend` t+romanianFormMessage (MsgInvalidNumber t) = "Număr nevalid: " `mappend` t+romanianFormMessage (MsgInvalidEntry t) = "Valoare nevalidă: " `mappend` t+romanianFormMessage MsgInvalidTimeFormat = "Oră nevalidă. Formatul necesar este HH:MM[:SS]"+romanianFormMessage MsgInvalidDay = "Dată nevalidă. Formatul necesar este AAAA-LL-ZZ"+romanianFormMessage (MsgInvalidUrl t) = "Adresă URL nevalidă: " `mappend` t+romanianFormMessage (MsgInvalidEmail t) = "Adresă de e-mail nevalidă: " `mappend` t+romanianFormMessage (MsgInvalidHour t) = "Oră nevalidă: " `mappend` t+romanianFormMessage (MsgInvalidMinute t) = "Minut nevalid: " `mappend` t+romanianFormMessage (MsgInvalidSecond t) = "Secundă nevalidă: " `mappend` t+romanianFormMessage MsgCsrfWarning = "Ca protecție împotriva atacurilor CSRF, vă rugăm să confirmați trimiterea formularului."+romanianFormMessage MsgValueRequired = "Câmp obligatoriu"+romanianFormMessage (MsgInputNotFound t) = "Valoare inexistentă: " `mappend` t+romanianFormMessage MsgSelectNone = "<Niciuna>"+romanianFormMessage (MsgInvalidBool t) = "Valoare booleană nevalidă: " `mappend` t+romanianFormMessage MsgBoolYes = "Da"+romanianFormMessage MsgBoolNo = "Nu"+romanianFormMessage MsgDelete = "Șterge?"+romanianFormMessage (MsgInvalidHexColorFormat t) = "Culoare nevalidă. Formatul necesar este #rrggbb în hexazecimal: " `mappend` t+romanianFormMessage (MsgInvalidDatetimeFormat t) = "Data și ora nevalidă, trebuie să fie în format AAAA-LL-ZZ(T| )HH:MM[:SS]: " `mappend` t
Yesod/Form/I18n/Russian.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Russian where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) russianFormMessage :: FormMessage -> Text-russianFormMessage (MsgInvalidInteger t) = "Неверно записано целое число: " `Data.Monoid.mappend` t+russianFormMessage (MsgInvalidInteger t) = "Неверно записано целое число: " `mappend` t russianFormMessage (MsgInvalidNumber t) = "Неверный формат числа: " `mappend` t russianFormMessage (MsgInvalidEntry t) = "Неверный выбор: " `mappend` t russianFormMessage MsgInvalidTimeFormat = "Неверно указано время, используйте формат ЧЧ:ММ[:СС]"@@ -24,3 +24,5 @@ russianFormMessage MsgBoolYes = "Да" russianFormMessage MsgBoolNo = "Нет" russianFormMessage MsgDelete = "Удалить?"+russianFormMessage (MsgInvalidHexColorFormat t) = "Недопустимое значение цвета, должен быть в шестнадцатеричном формате #rrggbb: " `mappend` t+russianFormMessage (MsgInvalidDatetimeFormat t) = "Недопустимое значение даты и времени. Должно быть в формате ГГГГ-ММ-ДД(T| )ЧЧ:ММ[:СС]: " `mappend` t
Yesod/Form/I18n/Spanish.hs view
@@ -3,11 +3,10 @@ module Yesod.Form.I18n.Spanish where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) spanishFormMessage :: FormMessage -> Text-spanishFormMessage (MsgInvalidInteger t) = "Número entero inválido: " `Data.Monoid.mappend` t+spanishFormMessage (MsgInvalidInteger t) = "Número entero inválido: " `mappend` t spanishFormMessage (MsgInvalidNumber t) = "Número inválido: " `mappend` t spanishFormMessage (MsgInvalidEntry t) = "Entrada inválida: " `mappend` t spanishFormMessage MsgInvalidTimeFormat = "Hora inválida, debe tener el formato HH:MM[:SS]"@@ -25,3 +24,5 @@ spanishFormMessage MsgBoolYes = "Sí" spanishFormMessage MsgBoolNo = "No" spanishFormMessage MsgDelete = "¿Eliminar?"+spanishFormMessage (MsgInvalidHexColorFormat t) = "Color no válido, debe estar en formato hexadecimal #rrggbb: " `mappend` t+spanishFormMessage (MsgInvalidDatetimeFormat t) = "Fecha y hora no válida; debe estar en formato AAAA-MM-DD(T| )HH:MM[:SS]: " `mappend` t
Yesod/Form/I18n/Swedish.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Form.I18n.Swedish where import Yesod.Form.Types (FormMessage (..))-import Data.Monoid (mappend) import Data.Text (Text) swedishFormMessage :: FormMessage -> Text-swedishFormMessage (MsgInvalidInteger t) = "Ogiltigt antal: " `Data.Monoid.mappend` t+swedishFormMessage (MsgInvalidInteger t) = "Ogiltigt antal: " `mappend` t swedishFormMessage (MsgInvalidNumber t) = "Ogiltigt nummer: " `mappend` t swedishFormMessage (MsgInvalidEntry t) = "Invalid entry: " `mappend` t swedishFormMessage MsgInvalidTimeFormat = "Ogiltigt klockslag, måste vara på formatet HH:MM[:SS]"@@ -24,3 +24,5 @@ swedishFormMessage MsgBoolNo = "Nej" swedishFormMessage MsgDelete = "Radera?" swedishFormMessage MsgCsrfWarning = "Som skydd mot \"cross-site request forgery\" attacker, vänligen bekräfta skickandet av formuläret."+swedishFormMessage (MsgInvalidHexColorFormat t) = "Ogiltig färg, måste vara i #rrggbb hexadecimalt format: " `mappend` t+swedishFormMessage (MsgInvalidDatetimeFormat t) = "Ogiltig datumtid, måste vara i formatet ÅÅÅÅ-MM-DD(T| )TT:MM[:SS]: " `mappend` t
Yesod/Form/Input.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+ -- | Provides for getting input from either GET or POST params without -- generating HTML forms. For more information, see: -- <http://www.yesodweb.com/book/forms#forms_kinds_of_forms>.@@ -15,7 +16,6 @@ import Yesod.Form.Types import Data.Text (Text)-import Control.Applicative (Applicative (..)) import Yesod.Core import Control.Monad (liftM, (<=<)) import qualified Data.Map as Map@@ -29,7 +29,7 @@ newtype FormInput m a = FormInput { unFormInput :: HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a) } instance Monad m => Functor (FormInput m) where fmap a (FormInput f) = FormInput $ \c d e e' -> liftM (either Left (Right . a)) $ f c d e e'-instance Monad m => Control.Applicative.Applicative (FormInput m) where+instance Monad m => Applicative (FormInput m) where pure = FormInput . const . const . const . const . return . Right (FormInput f) <*> (FormInput x) = FormInput $ \c d e e' -> do res1 <- f c d e e'
Yesod/Form/Jquery.hs view
@@ -1,7 +1,9 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+ -- | Some fields spiced up with jQuery UI. module Yesod.Form.Jquery ( YesodJquery (..)@@ -20,11 +22,10 @@ import Data.Default import Text.Julius (rawJS) import Data.Text (Text, pack, unpack)-import Data.Monoid (mconcat) -- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme. googleHostedJqueryUiCss :: Text -> Text-googleHostedJqueryUiCss theme = Data.Monoid.mconcat+googleHostedJqueryUiCss theme = mconcat [ "//ajax.googleapis.com/ajax/libs/jqueryui/1.8/themes/" , theme , "/jquery-ui.css"
Yesod/Form/MassInput.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-}+ -- | A module providing a means of creating multiple input forms, such as a -- list of 0 or more recipients. module Yesod.Form.MassInput
Yesod/Form/Nic.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+ -- | Provide the user with a rich text editor. -- -- According to NIC editor homepage it is not actively maintained since June
+ Yesod/Form/Option.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleContexts #-}++module Yesod.Form.Option where++import Yesod.Core+import Yesod.Form.Fields++-- | Creates an `OptionList` from a `List`, using the `PathPiece` instance for+-- the external value and a custom function for the user-facing value.+--+-- @since 1.7.7+--+-- PathPiece instances should provide suitable external values, since path+-- pieces serve to be exposed through URLs or HTML anyway. Show/Read instances+-- are avoided here since they could leak internal representations to forms,+-- query params, javascript etc.+--+-- === __Example usage__+--+-- > data UserRole = URSalesTeam | URSalesHead | URTechTeam | URTechHead+-- >+-- > instance PathPiece UserDepartment where+-- > toPathPiece = \case+-- > URSalesTeam -> "sales-team"+-- > URSalesHead -> "sales-head"+-- > URTechTeam -> "tech-team"+-- > URTechHead -> "tech-head"+-- > fromPathPiece = \case+-- > "sales-team" -> Just URSalesTeam+-- > "sales-head" -> Just URSalesHead+-- > "tech-team" -> Just URTechTeam+-- > "tech-head" -> Just URTechHead+-- > _ -> Nothing+-- >+-- > userRoleOptions ::+-- > (MonadHandler m, RenderMessage (HandlerSite m) msg) => m (OptionList UserRole)+-- > userRoleOptions = optionsFromList' userRoles toMsg+-- > where+-- > userRoles = [URSalesTeam, URSalesHead, URTechTeam, URTechHead]+-- > toMsg :: UserRole -> Text+-- > toMsg = \case+-- > URSalesTeam -> "Sales Team"+-- > URSalesHead -> "Head of Sales Team"+-- > URTechTeam -> "Tech Team"+-- > URTechHead -> "Head of Tech Team"+--+-- userRoleOptions, will produce an OptionList with the following attributes:+--+-- > +----------------+----------------+--------------------++-- > | Internal Value | External Value | User-facing Value |+-- > +----------------+----------------+--------------------++-- > | URSalesTeam | sales-team | Sales Team |+-- > +----------------+----------------+--------------------++-- > | URSalesHead | sales-head | Head of Sales Team |+-- > +----------------+----------------+--------------------++-- > | URTechTeam | tech-team | Tech Team |+-- > +----------------+----------------+--------------------++-- > | URTechHead | tech-head | Head of Tech Team |+-- > +----------------+----------------+--------------------++--+-- Note that the type constraint allows localizable messages in place of toMsg (see+-- https://en.wikipedia.org/wiki/Yesod_(web_framework)#Localizable_messages).++optionsFromList' ::+ MonadHandler m+ => RenderMessage (HandlerSite m) msg+ => PathPiece a+ => [a]+ -> (a -> msg)+ -> m (OptionList a)+optionsFromList' lst toDisplay = do+ mr <- getMessageRender+ pure $ mkOptionList $ flip map lst $ \v -> Option+ { optionDisplay = mr $ toDisplay v+ , optionInternalValue = v+ , optionExternalValue = toPathPiece v+ }++-- | Creates an `OptionList` from an `Enum`.+--+-- @since 1.7.7+--+-- optionsEnum' == optionsFromList' [minBound..maxBound]+--+-- Creates an `OptionList` containing every constructor of `a`, so that these+-- constructors do not need to be typed out. Bounded and Enum instances must+-- exist for `a` to use this.+optionsEnum' ::+ MonadHandler m+ => RenderMessage (HandlerSite m) msg+ => PathPiece a+ => Enum a+ => Bounded a+ => (a -> msg)+ -> m (OptionList a)+optionsEnum' = optionsFromList' [minBound..maxBound]
Yesod/Form/Types.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+ module Yesod.Form.Types ( -- * Helpers Enctype (..)@@ -25,18 +26,16 @@ import Control.Monad.Trans.RWS (RWST) import Control.Monad.Trans.Writer (WriterT) import Data.Text (Text)-import Data.Monoid (Monoid (..)) import Text.Blaze (Markup, ToMarkup (toMarkup), ToValue (toValue)) #define Html Markup #define ToHtml ToMarkup #define toHtml toMarkup-import Control.Applicative ((<$>), Alternative (..), Applicative (..))+import Control.Applicative (Alternative (..)) import Control.Monad (liftM) import Control.Monad.Trans.Class import Data.String (IsString (..)) import Yesod.Core import qualified Data.Map as Map-import Data.Semigroup (Semigroup, (<>)) import Data.Traversable import Data.Foldable @@ -55,18 +54,18 @@ fmap _ FormMissing = FormMissing fmap _ (FormFailure errs) = FormFailure errs fmap f (FormSuccess a) = FormSuccess $ f a-instance Control.Applicative.Applicative FormResult where+instance Applicative FormResult where pure = FormSuccess (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y (FormFailure x) <*> _ = FormFailure x _ <*> (FormFailure y) = FormFailure y _ <*> _ = FormMissing-instance Data.Monoid.Monoid m => Monoid (FormResult m) where+instance Monoid m => Monoid (FormResult m) where mempty = pure mempty- mappend x y = mappend <$> x <*> y+ mappend = (<>) instance Semigroup m => Semigroup (FormResult m) where- x <> y = (<>) Control.Applicative.<$> x <*> y+ x <> y = (<>) <$> x <*> y -- | @since 1.4.5 instance Data.Foldable.Foldable FormResult where@@ -104,9 +103,6 @@ toValue Multipart = "multipart/form-data" instance Monoid Enctype where mempty = UrlEncoded-#if !(MIN_VERSION_base(4,11,0))- mappend = (<>)-#endif instance Semigroup Enctype where UrlEncoded <> UrlEncoded = UrlEncoded _ <> _ = Multipart@@ -166,9 +162,21 @@ (a, b, ints', c) <- f mr env ints (x, y, ints'', z) <- g mr env ints' return (a <*> x, b . y, ints'', c `mappend` z)++#if MIN_VERSION_transformers(0,6,0)+instance Monad m => Monad (AForm m) where+ (AForm f) >>= k = AForm $ \mr env ints -> do+ (a, b, ints', c) <- f mr env ints+ case a of+ FormSuccess r -> do+ (x, y, ints'', z) <- unAForm (k r) mr env ints'+ return (x, b . y, ints'', c `mappend` z)+ FormFailure err -> pure (FormFailure err, b, ints', c)+ FormMissing -> pure (FormMissing, b, ints', c)+#endif instance (Monad m, Monoid a) => Monoid (AForm m a) where mempty = pure mempty- mappend a b = mappend <$> a <*> b+ mappend = (<>) instance (Monad m, Semigroup a) => Semigroup (AForm m a) where a <> b = (<>) <$> a <*> b @@ -229,4 +237,6 @@ | MsgBoolYes | MsgBoolNo | MsgDelete+ | MsgInvalidHexColorFormat Text+ | MsgInvalidDatetimeFormat Text deriving (Show, Eq, Read)
yesod-form.cabal view
@@ -1,5 +1,6 @@+cabal-version: >= 1.10 name: yesod-form-version: 1.6.7+version: 1.7.9.3 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -7,10 +8,9 @@ synopsis: Form handling support for Yesod Web Framework category: Web, Yesod stability: Stable-cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/-description: API docs and the README are available at <http://www.stackage.org/package/yesod-form>. Third-party packages which you can find useful: <http://hackage.haskell.org/package/yesod-form-richtext yesod-form-richtext> - richtext form fields (currntly it provides only Summernote support).+description: API docs and the README are available at <http://www.stackage.org/package/yesod-form>. Third-party packages which you can find useful: <http://hackage.haskell.org/package/yesod-form-richtext yesod-form-richtext> - richtext form fields (currently it provides only Summernote support). extra-source-files: ChangeLog.md README.md @@ -19,7 +19,8 @@ default: True library- build-depends: base >= 4 && < 5+ default-language: Haskell2010+ build-depends: base >= 4.11 && < 5 , aeson , attoparsec >= 0.10 , blaze-builder >= 0.2.1.4@@ -32,20 +33,20 @@ , email-validate >= 1.0 , persistent , resourcet- , semigroups , shakespeare >= 2.0 , text >= 0.9 , time >= 1.1.4 , transformers >= 0.2.2 , wai >= 1.3 , xss-sanitize >= 0.3.0.1- , yesod-core >= 1.6 && < 1.7+ , yesod-core >= 1.6 && < 1.8 , yesod-persistent >= 1.6 && < 1.7 if flag(network-uri) build-depends: network-uri >= 2.6 exposed-modules: Yesod.Form+ Yesod.Form.Option Yesod.Form.Types Yesod.Form.Functions Yesod.Form.Bootstrap3@@ -67,10 +68,12 @@ Yesod.Form.I18n.Spanish Yesod.Form.I18n.Chinese Yesod.Form.I18n.Korean+ Yesod.Form.I18n.Romanian -- FIXME Yesod.Helpers.Crud ghc-options: -Wall test-suite test+ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: test