Compare commits
2 Commits
6367bf8a86
...
e63bfdca3c
Author | SHA1 | Date | |
---|---|---|---|
e63bfdca3c | |||
4813d5dd60 |
44
drop/regex-and-validation-examples.purs
Normal file
44
drop/regex-and-validation-examples.purs
Normal file
@ -0,0 +1,44 @@
|
||||
import Data.String.Regex as R
|
||||
import Data.String.Regex.Flags as RF
|
||||
import Data.Validation.Semigroup (V, andThen, invalid, toEither)
|
||||
|
||||
andThenDrop :: forall errors a b. V errors a -> V errors b -> V errors b
|
||||
-- andThenDrop f1 f2 = f1 !> (\ _ -> f2)
|
||||
|
||||
infixl 8 andThen as !>
|
||||
-- infixl 8 andThenDrop as !<
|
||||
|
||||
name_format :: String
|
||||
name_format = "[a-zA-Z]+"
|
||||
protocol_format :: String
|
||||
protocol_format = "^(tcp|udp|sctp)$"
|
||||
hostname_format :: String
|
||||
hostname_format = "^(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9-]*[a-zA-Z0-9]).)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9-]*[A-Za-z0-9])[.]?$"
|
||||
-- Basic tools for validation.
|
||||
|
||||
lengthIsBetween :: Attribute -> Int -> Int -> String -> V Errors String
|
||||
lengthIsBetween field minlen maxlen value
|
||||
= if valid_condition
|
||||
then pure value
|
||||
else invalid [ Tuple field error_message ]
|
||||
where
|
||||
actual_len = S.length value
|
||||
valid_condition = actual_len >= minlen && actual_len <= maxlen
|
||||
error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]"
|
||||
|
||||
-- | `matches` is a simple format verification based on regex parsing.
|
||||
-- | `verify_regex` is a handler to use `matches` with a string regex format.
|
||||
-- |
|
||||
-- | ```
|
||||
-- | verify_regex Name name_format name
|
||||
-- | ```
|
||||
matches :: Attribute -> String -> R.Regex -> V Errors String
|
||||
matches field value regex
|
||||
| R.test regex value = pure value
|
||||
| otherwise = invalid [Tuple field "unacceptable format"]
|
||||
|
||||
verify_regex :: Attribute -> String -> String -> V Errors String
|
||||
verify_regex field restr value
|
||||
= case R.regex restr RF.unicode of
|
||||
Left error_string -> invalid [Tuple field $ "error in regex: " <> error_string]
|
||||
Right regex -> matches field value regex
|
Loading…
Reference in New Issue
Block a user