factor/extra/http/server/validators/validators.factor

79 lines
1.9 KiB
Factor
Raw Normal View History

2008-03-05 22:38:15 -05:00
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
2008-04-14 04:03:49 -04:00
USING: kernel continuations sequences math namespaces sets
2008-03-29 00:00:20 -04:00
math.parser assocs regexp fry unicode.categories sequences ;
2008-03-05 22:38:15 -05:00
IN: http.server.validators
2008-03-14 18:40:47 -04:00
SYMBOL: validation-failed?
2008-03-05 22:38:15 -05:00
TUPLE: validation-error value reason ;
2008-03-14 18:40:47 -04:00
C: <validation-error> validation-error
: with-validator ( value quot -- result )
[ validation-failed? on <validation-error> ] recover ;
inline
2008-03-05 22:38:15 -05:00
: v-default ( str def -- str )
over empty? spin ? ;
: v-required ( str -- str )
2008-03-14 18:40:47 -04:00
dup empty? [ "required" throw ] when ;
2008-03-05 22:38:15 -05:00
: v-min-length ( str n -- str )
over length over < [
[ "must be at least " % # " characters" % ] "" make
2008-03-14 18:40:47 -04:00
throw
2008-03-05 22:38:15 -05:00
] [
drop
] if ;
: v-max-length ( str n -- str )
over length over > [
[ "must be no more than " % # " characters" % ] "" make
2008-03-14 18:40:47 -04:00
throw
2008-03-05 22:38:15 -05:00
] [
drop
] if ;
: v-number ( str -- n )
2008-03-14 18:40:47 -04:00
dup string>number [ ] [ "must be a number" throw ] ?if ;
2008-03-05 22:38:15 -05:00
2008-03-15 07:22:47 -04:00
: v-integer ( n -- n )
dup integer? [ "must be an integer" throw ] unless ;
2008-03-11 04:39:09 -04:00
: v-min-value ( x n -- x )
2008-03-05 22:38:15 -05:00
2dup < [
2008-03-14 18:40:47 -04:00
[ "must be at least " % # ] "" make throw
2008-03-05 22:38:15 -05:00
] [
drop
] if ;
2008-03-11 04:39:09 -04:00
: v-max-value ( x n -- x )
2008-03-05 22:38:15 -05:00
2dup > [
2008-03-14 18:40:47 -04:00
[ "must be no more than " % # ] "" make throw
2008-03-05 22:38:15 -05:00
] [
drop
] if ;
2008-03-11 04:39:09 -04:00
: v-regexp ( str what regexp -- str )
>r over r> matches?
[ drop ] [ "invalid " prepend throw ] if ;
2008-03-11 04:39:09 -04:00
: v-email ( str -- str )
#! From http://www.regular-expressions.info/email.html
"e-mail"
R/ [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}/i
v-regexp ;
: v-captcha ( str -- str )
2008-03-14 18:40:47 -04:00
dup empty? [ "must remain blank" throw ] unless ;
2008-03-11 04:39:09 -04:00
: v-one-line ( str -- str )
dup "\r\n" intersect empty?
2008-03-14 18:40:47 -04:00
[ "must be a single line" throw ] unless ;
2008-03-11 04:39:09 -04:00
: v-one-word ( str -- str )
dup [ alpha? ] all?
2008-03-14 18:40:47 -04:00
[ "must be a single word" throw ] unless ;