Permalink
Browse files

[feature] WFormBuilder: Adding an URL validator.

  • Loading branch information...
1 parent 750fba9 commit e92e9cc9ff028cd88a975b0240fe07a1114c1f85 @akoprow akoprow committed Jun 6, 2011
Showing with 54 additions and 0 deletions.
  1. +35 −0 stdlib/core/web/core/uri.opa
  2. +19 −0 stdlib/widgets/formbuilder/formbuilder.opa
@@ -25,6 +25,8 @@
import stdlib.core.{parser}
+// FIXME, this module needs a clean-up
+
/**
* {1 About this module}
*
@@ -317,11 +319,44 @@ Uri =
* @param s A string
* @return true if the string represents a valid [http], [https] or [mailto] URI.
*/
+ // FIXME, secure? in what sense secure?
is_secure(s:string) =
match of_string(s) with
| {none} -> false
| _ -> true
+ /* FIXME, the distinction between relative/absolute URIs is not too good; improve?*/
+ is_absolute(uri : Uri.uri) : bool =
+ match uri with
+ | ~{schema=_ domain=_ path=_ ...} -> true
+ | _ -> false
+
+ /**
+ * Returns true for a valid, non-local HTTP(s) address.
+ *
+ * @param uri an URI
+ * @return true iff [uri] is a valid HTTP(s) address (syntactically; it doesn't
+ * mean that such a page exists/is up and running).
+ */
+ is_valid_http(uri : Uri.uri) : bool =
+ path_contains_a_dot =
+ | [hd|_] -> String.index(".", hd) |> Option.is_some
+ | _ -> false
+ match uri with
+ /* absolute URIs are OK if they have HTTP/HTTPs schemas or at least one
+ dot in the path ([localhost] is not good, [test.com] is) */
+ | ~{schema path ...} ->
+ (match schema : option(string) with
+ | {some="http"} -> true
+ | {some="https"} -> true
+ | {some=_} -> false
+ | {none} -> path_contains_a_dot(path)
+ )
+ /* relative URIs are OK if they have a dot in the path (as above) */
+ | ~{path ...} -> path_contains_a_dot(path)
+ /* email addresses are not ok */
+ | {address=_ query=_} -> false
+
/**
* Conversion from URIs to their string representation.
*
@@ -186,6 +186,16 @@ WFormBuilder =
else
{failure = error_msg}
+ url_validator(error_msg : xhtml) : WFormBuilder.validator =
+ input ->
+ match Uri.of_string(input) with
+ | {none} -> {failure = error_msg}
+ | {some=uri} ->
+ if Uri.is_valid_http(uri) then
+ {success = input}
+ else
+ {failure = error_msg}
+
merge_validators(vs : list(WFormBuilder.validator)) : WFormBuilder.validator =
rec aux(input) =
| [] -> { success=input }
@@ -216,6 +226,15 @@ WFormBuilder =
: WFormBuilder.field =
add_validator(field, email_validator(err_msg))
+ add_default_email_validator(field : WFormBuilder.field) : WFormBuilder.field =
+ add_email_validator(field, <>This is not a valid email address.</>)
+
+ add_url_validator(field : WFormBuilder.field, err_msg : xhtml) : WFormBuilder.field =
+ add_validator(field, url_validator(err_msg))
+
+ add_default_url_validator(field : WFormBuilder.field) : WFormBuilder.field =
+ add_url_validator(field, <>This does not seem to be a valid URL.</>)
+
set_id(field : WFormBuilder.field, id : string) : WFormBuilder.field =
{field with ~id}

0 comments on commit e92e9cc

Please sign in to comment.