Merge pull request #1817 from ciukstar/datetime-local-field

Add datetimeLocalField

yesod-form/ChangeLog.md

@@ -1,5 +1,9 @@
 # ChangeLog for yesod-form
 
+## 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)

yesod-form/Yesod/Form/Fields.hs

@@ -64,6 +64,7 @@ module Yesod.Form.Fields
     , optionsPairsGrouped
     , optionsEnum
     , colorField
+    , datetimeLocalField
     ) where
 
 import Yesod.Form.Types
@@ -74,7 +75,7 @@ import Text.Blaze (ToMarkup (toMarkup), unsafeByteString)
 #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)
@@ -98,7 +99,8 @@ import Text.Blaze.Html.Renderer.String (renderHtml)
 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
@@ -998,3 +1000,24 @@ $newline never
       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/Yesod/Form/I18n/Chinese.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/Croatian.hs

@@ -25,3 +25,4 @@ croatianFormMessage MsgBoolYes            = "Da"
 croatianFormMessage MsgBoolNo             = "Ne"
 croatianFormMessage MsgDelete             = "Izbrisati?"
 croatianFormMessage (MsgInvalidHexColorFormat t) = "Nevažeća boja, mora biti u #rrggbb heksadecimalnom formatu: " `mappend` t
+croatianFormMessage (MsgInvalidDatetimeFormat t) = "Nevažeći datum i vrijeme, mora biti u formatu GGGG-MM-DD(T| )HH:MM[:SS]: " `mappend` t

yesod-form/Yesod/Form/I18n/Czech.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/Dutch.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/English.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/French.hs

@@ -24,4 +24,5 @@ frenchFormMessage (MsgInvalidBool t) = "Booléen invalide : " `mappend` t
 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 (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/Yesod/Form/I18n/German.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/Japanese.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/Korean.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/Norwegian.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/Portuguese.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/I18n/Romanian.hs

@@ -28,3 +28,4 @@ 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/Yesod/Form/I18n/Russian.hs

@@ -25,3 +25,4 @@ russianFormMessage MsgBoolYes = "Да"
 russianFormMessage MsgBoolNo = "Нет"
 russianFormMessage MsgDelete = "Удалить?"
 russianFormMessage (MsgInvalidHexColorFormat t) = "Недопустимое значение цвета, должен быть в шестнадцатеричном формате #rrggbb: " `mappend` t
+russianFormMessage (MsgInvalidDatetimeFormat t) = "Недопустимое значение даты и времени. Должно быть в формате ГГГГ-ММ-ДД(T| )ЧЧ:ММ[:СС]: " `mappend` t

yesod-form/Yesod/Form/I18n/Spanish.hs

@@ -26,3 +26,4 @@ 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/Yesod/Form/I18n/Swedish.hs

@@ -25,3 +25,4 @@ 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/Yesod/Form/Types.hs

@@ -242,4 +242,5 @@ data FormMessage = MsgInvalidInteger Text
                  | MsgBoolNo
                  | MsgDelete
                  | MsgInvalidHexColorFormat Text
+                 | MsgInvalidDatetimeFormat Text
     deriving (Show, Eq, Read)

yesod-form/yesod-form.cabal

@@ -1,6 +1,6 @@
 cabal-version:   >= 1.10
 name:            yesod-form
-version:         1.7.5
+version:         1.7.6
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>