{-# LANGUAGE OverloadedStrings #-}
module Text.HTML.Form.Validate(isInputValid, isInputValid', isFormValid, isFormValid',
inputErrorMessage, inputErrorMessage', normalizeInput, normalizeForm) where
import Text.HTML.Form hiding (lang)
import Text.HTML.Form.I18n
import qualified Data.Text as Txt
import Text.Read (readMaybe)
import Data.Hourglass
import Network.URI (parseAbsoluteURI)
import Data.Maybe (isJust, isNothing)
import Text.Regex.TDFA ((=~), matchTest)
isFormValid :: Form -> Bool
isFormValid :: Form -> Bool
isFormValid = (Input -> Bool) -> [Input] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Input -> Bool
isInputValid ([Input] -> Bool) -> (Form -> [Input]) -> Form -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> [Input]
inputs
isFormValid' :: Form -> Bool
isFormValid' :: Form -> Bool
isFormValid' = (Input -> Bool) -> [Input] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Input -> Bool
isInputValid' ([Input] -> Bool) -> (Form -> [Input]) -> Form -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> [Input]
inputs
isInputValid :: Input -> Bool
isInputValid :: Input -> Bool
isInputValid = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (Input -> String) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Input -> String
inputErrorMessage String
"en"
isInputValid' :: Input -> Bool
isInputValid' :: Input -> Bool
isInputValid' = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (Input -> String) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Input -> String
inputErrorMessage' String
"en"
inputErrorMessage :: String -> Input -> String
inputErrorMessage :: String -> Input -> String
inputErrorMessage String
_ Input { inputType :: Input -> Text
inputType = Text
"hidden" } = String
""
inputErrorMessage String
lang self :: Input
self@Input { required :: Input -> Bool
required = Bool
True }
| Input -> Text
inputType Input
self Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"checkbox", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Input -> Bool
checked Input
self = String -> String -> String
i18n String
lang String
"err required"
| Input -> Text
value Input
self Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = String -> String -> String
i18n String
lang String
"err required"
inputErrorMessage String
_ Input { value :: Input -> Text
value = Text
"" } = String
""
inputErrorMessage String
lang self :: Input
self@Input { pattern :: Input -> Maybe Regex
pattern = Just Regex
re }
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Regex
re Regex -> Text -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
`matchTest` Input -> Text
value Input
self = String -> String -> String
i18n String
lang String
"err format"
inputErrorMessage String
lang Input { lengthRange :: Input -> (Maybe Int, Maybe Int)
lengthRange = (Just Int
min', Maybe Int
_), value :: Input -> Text
value = Text
val }
| Text -> Int
Txt.length Text
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min' = String -> String -> Int -> String
forall a. Show a => String -> String -> a -> String
i18n' String
lang String
"err min chars" Int
min'
inputErrorMessage String
lang Input { lengthRange :: Input -> (Maybe Int, Maybe Int)
lengthRange = (Maybe Int
_, Just Int
max'), value :: Input -> Text
value = Text
val }
| Text -> Int
Txt.length Text
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max' = String -> String -> Int -> String
forall a. Show a => String -> String -> a -> String
i18n' String
lang String
"err max chars" Int
max'
inputErrorMessage String
lang Input { range :: Input -> (Maybe Text, Maybe Text)
range = (Just Text
min', Maybe Text
_), value :: Input -> Text
value = Text
val }
| Just Float
x <- Text -> Maybe Float
forall a. Read a => Text -> Maybe a
readMaybe' Text
val :: Maybe Float, Just Float
y <- Text -> Maybe Float
forall a. Read a => Text -> Maybe a
readMaybe' Text
min', Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
y =
String -> String -> Text -> String
forall a. Show a => String -> String -> a -> String
i18n' String
lang String
"err min" Text
min'
inputErrorMessage String
lang Input { range :: Input -> (Maybe Text, Maybe Text)
range = (Maybe Text
_, Just Text
max'), value :: Input -> Text
value = Text
val }
| Just Float
x <- Text -> Maybe Float
forall a. Read a => Text -> Maybe a
readMaybe' Text
val :: Maybe Float, Just Float
y <- Text -> Maybe Float
forall a. Read a => Text -> Maybe a
readMaybe' Text
max', Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
y =
String -> String -> Text -> String
forall a. Show a => String -> String -> a -> String
i18n' String
lang String
"err max" Text
max'
inputErrorMessage String
lang Input { range :: Input -> (Maybe Text, Maybe Text)
range = (Just Text
min', Maybe Text
_), step :: Input -> Maybe Text
step = Just Text
step', value :: Input -> Text
value = Text
val }
| Just Integer
x <- Text -> Maybe Integer
forall a. Read a => Text -> Maybe a
readMaybe' Text
val :: Maybe Integer, Just Integer
y <- Text -> Maybe Integer
forall a. Read a => Text -> Maybe a
readMaybe' Text
min',
Just Integer
z <- Text -> Maybe Integer
forall a. Read a => Text -> Maybe a
readMaybe' Text
step', Integer
z Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0, Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y) Integer
z Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 =
String -> String -> Text -> Text -> String
forall a b.
(Show a, Show b) =>
String -> String -> a -> b -> String
i18n2 String
lang String
"err increments" Text
step' Text
min'
inputErrorMessage String
lang Input { range :: Input -> (Maybe Text, Maybe Text)
range = (Just Text
min', Maybe Text
_), value :: Input -> Text
value = Text
val }
| Just DateTime
x <- String -> Maybe DateTime
parseTime (String -> Maybe DateTime) -> String -> Maybe DateTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
val, Just DateTime
y <- String -> Maybe DateTime
parseTime (String -> Maybe DateTime) -> String -> Maybe DateTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
min',
DateTime
x DateTime -> DateTime -> Bool
forall a. Ord a => a -> a -> Bool
< DateTime
y = String -> String -> Text -> String
forall a. Show a => String -> String -> a -> String
i18n' String
lang String
"err min" Text
min'
inputErrorMessage String
lang Input { range :: Input -> (Maybe Text, Maybe Text)
range = (Maybe Text
_, Just Text
max'), value :: Input -> Text
value = Text
val }
| Just DateTime
x <- String -> Maybe DateTime
parseTime (String -> Maybe DateTime) -> String -> Maybe DateTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
val, Just DateTime
y <- String -> Maybe DateTime
parseTime (String -> Maybe DateTime) -> String -> Maybe DateTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
max',
DateTime
x DateTime -> DateTime -> Bool
forall a. Ord a => a -> a -> Bool
> DateTime
y = String -> String -> Text -> String
forall a. Show a => String -> String -> a -> String
i18n' String
lang String
"err max" Text
max'
inputErrorMessage String
lang Input {
range :: Input -> (Maybe Text, Maybe Text)
range = (Just Text
min', Maybe Text
_), step :: Input -> Maybe Text
step = Just Text
step',
inputType :: Input -> Text
inputType = Text
ty, value :: Input -> Text
value = Text
val
}
| Text
ty Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"date", Just DateTime
x <- String -> Maybe DateTime
parseTime (String -> Maybe DateTime) -> String -> Maybe DateTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
val,
Just DateTime
y <- String -> Maybe DateTime
parseTime (String -> Maybe DateTime) -> String -> Maybe DateTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
min', Just Seconds
z <- Text -> Maybe Seconds
forall a. Read a => Text -> Maybe a
readMaybe' Text
step',
DateTime -> DateTime -> Seconds
forall t1 t2. (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds
timeDiff DateTime
x DateTime
y Seconds -> Seconds -> Seconds
forall a. Integral a => a -> a -> a
`rem` Duration -> Seconds
forall i. TimeInterval i => i -> Seconds
toSeconds Duration
forall a. Monoid a => a
mempty { durationSeconds = 24*z } Seconds -> Seconds -> Bool
forall a. Eq a => a -> a -> Bool
== Int64 -> Seconds
Seconds Int64
0 =
String -> String -> Text -> Text -> String
forall a b.
(Show a, Show b) =>
String -> String -> a -> b -> String
i18n2 String
lang String
"err increments" Text
step' Text
min'
| Text
ty Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"month" = String
""
| Just DateTime
x <- String -> Maybe DateTime
parseTime (String -> Maybe DateTime) -> String -> Maybe DateTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
val, Just DateTime
y <- String -> Maybe DateTime
parseTime (String -> Maybe DateTime) -> String -> Maybe DateTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
min',
Just Int64
z <- Text -> Maybe Int64
forall a. Read a => Text -> Maybe a
readMaybe' Text
step', DateTime -> DateTime -> Seconds
forall t1 t2. (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds
timeDiff DateTime
x DateTime
y Seconds -> Seconds -> Seconds
forall a. Integral a => a -> a -> a
`rem` Int64 -> Seconds
Seconds Int64
z Seconds -> Seconds -> Bool
forall a. Eq a => a -> a -> Bool
== Int64 -> Seconds
Seconds Int64
0 =
String -> String -> Text -> Text -> String
forall a b.
(Show a, Show b) =>
String -> String -> a -> b -> String
i18n2 String
lang String
"err increments" Text
step' Text
min'
inputErrorMessage String
lang self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"color" }
| (String
"#[0-9a-fA-F]{6}" :: String) String -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Input -> Text
value Input
self = String -> String -> String
i18n String
lang String
"err colour"
inputErrorMessage String
lang self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"date" } = String -> Input -> String
isTime' String
lang Input
self
inputErrorMessage String
lang self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"datetime" } = String -> Input -> String
isTime' String
lang Input
self
inputErrorMessage String
l self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"datetime-local" } = String -> Input -> String
isTime' String
l Input
self
inputErrorMessage String
lang self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"email" }
| Char
'@' Char -> Text -> Bool
`Txt.elem` Input -> Text
value Input
self = String -> String -> String
i18n String
lang String
"err email"
inputErrorMessage String
lang self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"month" } = String -> Input -> String
isTime' String
lang Input
self
inputErrorMessage String
lang Input { inputType :: Input -> Text
inputType = Text
"number", value :: Input -> Text
value = Text
val }
| Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> Maybe Float
forall a. Read a => Text -> Maybe a
readMaybe' Text
val :: Maybe Float) = String -> String -> String
i18n String
lang String
"err number"
inputErrorMessage String
lang Input { inputType :: Input -> Text
inputType = Text
"range", value :: Input -> Text
value = Text
val }
| Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> Maybe Float
forall a. Read a => Text -> Maybe a
readMaybe' Text
val :: Maybe Float) = String -> String -> String
i18n String
lang String
"err number"
inputErrorMessage String
lang self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"time" } = String -> Input -> String
isTime' String
lang Input
self
inputErrorMessage String
lang self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"url" }
| Text -> Bool
isURL (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Input -> Text
value Input
self = String -> String -> String
i18n String
lang String
"err URL"
inputErrorMessage String
lang self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"week" } = String -> Input -> String
isTime' String
lang Input
self
inputErrorMessage String
_ Input
_ = String
""
inputErrorMessage' :: String -> Input -> [Char]
inputErrorMessage' :: String -> Input -> String
inputErrorMessage' String
lang = String -> Input -> String
inputErrorMessage String
lang (Input -> String) -> (Input -> Input) -> Input -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Input
normalizeInput
parseTime :: String -> Maybe DateTime
parseTime :: String -> Maybe DateTime
parseTime = (LocalTime DateTime -> DateTime)
-> Maybe (LocalTime DateTime) -> Maybe DateTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap (Maybe (LocalTime DateTime) -> Maybe DateTime)
-> (String -> Maybe (LocalTime DateTime))
-> String
-> Maybe DateTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO8601_DateAndTime -> String -> Maybe (LocalTime DateTime)
forall format.
TimeFormat format =>
format -> String -> Maybe (LocalTime DateTime)
localTimeParse ISO8601_DateAndTime
ISO8601_DateAndTime
isTime :: Input -> Bool
isTime :: Input -> Bool
isTime = Maybe DateTime -> Bool
forall a. Maybe a -> Bool
isJust (Maybe DateTime -> Bool)
-> (Input -> Maybe DateTime) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe DateTime
parseTime (String -> Maybe DateTime)
-> (Input -> String) -> Input -> Maybe DateTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Txt.unpack (Text -> String) -> (Input -> Text) -> Input -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Text
value
isTime' :: String -> Input -> String
isTime' :: String -> Input -> String
isTime' String
lang Input
x | Input -> Bool
isTime Input
x = String
""
| Bool
otherwise = String -> String -> String
i18n String
lang String
"err time"
readMaybe' :: Read a => Txt.Text -> Maybe a
readMaybe' :: forall a. Read a => Text -> Maybe a
readMaybe' = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Txt.unpack
isURL :: Txt.Text -> Bool
isURL :: Text -> Bool
isURL = Maybe URI -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe URI -> Bool) -> (Text -> Maybe URI) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
parseAbsoluteURI (String -> Maybe URI) -> (Text -> String) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Txt.unpack
normalizeInput :: Input -> Input
normalizeInput :: Input -> Input
normalizeInput self :: Input
self@Input { inputType :: Input -> Text
inputType = Text
"url", value :: Input -> Text
value = Text
val }
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char
':' Char -> Text -> Bool
`Txt.elem` Text
val = Input
self {
value = "https://" `Txt.append` val
}
normalizeInput Input
self = Input
self
normalizeForm :: Form -> Form
normalizeForm :: Form -> Form
normalizeForm Form
self = Form
self { inputs = map normalizeInput $ inputs self }