{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Yesod.Form.Fields
( -- * i18n
FormMessage (..)
, defaultFormMessage
-- * Fields
, textField
, passwordField
, textareaField
, hiddenField
, intField
, dayField
, timeField
, htmlField
, emailField
, multiEmailField
, searchField
, AutoFocus
, urlField
, doubleField
, parseDate
, parseTime
, Textarea (..)
, boolField
, checkBoxField
, fileField
-- * File 'AForm's
, fileAFormReq
, fileAFormOpt
-- * Options
, selectField
, selectFieldList
, radioField
, radioFieldList
, checkboxesFieldList
, checkboxesField
, multiSelectField
, multiSelectFieldList
, Option (..)
, OptionList (..)
, mkOptionList
, optionsPersist
, optionsPersistKey
, optionsPairs
, optionsEnum
) where
import Yesod.Form.Types
import Yesod.Form.I18n.English
import Yesod.Form.Functions (parseHelper)
import Yesod.Core
import Text.Hamlet
import Text.Blaze (ToMarkup (toMarkup), unsafeByteString)
#define ToHtml ToMarkup
#define toHtml toMarkup
#define preEscapedText preEscapedToMarkup
import Text.Cassius
import Data.Time (Day, TimeOfDay(..))
import qualified Text.Email.Validate as Email
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Network.URI (parseURI)
import Database.Persist.Sql (PersistField, PersistFieldSql (..))
import Database.Persist (Entity (..), SqlType (SqlString))
import Text.HTML.SanitizeXSS (sanitizeBalance)
import Control.Monad (when, unless)
import Data.Either (partitionEithers)
import Data.Maybe (listToMaybe, fromMaybe)
import qualified Blaze.ByteString.Builder.Html.Utf8 as B
import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
import Database.Persist (PersistMonadBackend, PersistEntityBackend)
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, concat, intercalate, unpack, pack, splitOn)
import qualified Data.Text.Read
import qualified Data.Map as Map
import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery)
import Control.Arrow ((&&&))
import Control.Applicative ((<$>), (<|>))
import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly)
import Yesod.Persist.Core
defaultFormMessage :: FormMessage -> Text
defaultFormMessage = englishFormMessage
intField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Field m i
intField = Field
{ fieldParse = parseHelper $ \s ->
case Data.Text.Read.signed Data.Text.Read.decimal s of
Right (a, "") -> Right a
_ -> Left $ MsgInvalidInteger s
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
$newline never
|]
, fieldEnctype = UrlEncoded
}
where
showVal = either id (pack . showI)
showI x = show (fromIntegral x :: Integer)
doubleField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Double
doubleField = Field
{ fieldParse = parseHelper $ \s ->
case Data.Text.Read.double s of
Right (a, "") -> Right a
_ -> Left $ MsgInvalidNumber s
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
$newline never
|]
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . show)
dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day
dayField = Field
{ fieldParse = parseHelper $ parseDate . unpack
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
$newline never
|]
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . show)
timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay
timeField = Field
{ fieldParse = parseHelper parseTime
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
$newline never
|]
, fieldEnctype = UrlEncoded
}
where
showVal = either id (pack . show . roundFullSeconds)
roundFullSeconds tod =
TimeOfDay (todHour tod) (todMin tod) fullSec
where
fullSec = fromInteger $ floor $ todSec tod
htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html
htmlField = Field
{ fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
, fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
$newline never