forked from factor/factor
-
Notifications
You must be signed in to change notification settings - Fork 3
/
validators.factor
110 lines (89 loc) · 2.66 KB
/
validators.factor
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
! Copyright (C) 2006, 2010 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes continuations hashtables kernel
make math math.functions math.parser math.ranges namespaces
quotations regexp sequences sets unicode.case unicode.categories
words xmode.catalog ;
IN: validators
: v-checkbox ( str -- ? )
>lower "on" = ;
: v-default ( str def -- str/def )
[ drop empty? not ] most ;
: v-required ( str -- str )
dup empty? [ "required" throw ] when ;
: v-optional ( str quot -- result )
over empty? [ 2drop f ] [ call ] if ; inline
: v-min-length ( str n -- str )
over length over < [
[ "must be at least " % # " characters" % ] "" make
throw
] [
drop
] if ;
: v-max-length ( str n -- str )
over length over > [
[ "must be no more than " % # " characters" % ] "" make
throw
] [
drop
] if ;
: v-number ( str -- n )
dup string>number [ ] [ "must be a number" throw ] ?if ;
: v-integer ( str -- n )
v-number dup integer? [ "must be an integer" throw ] unless ;
: v-min-value ( x n -- x )
2dup < [
[ "must be at least " % # ] "" make throw
] [
drop
] if ;
: v-max-value ( x n -- x )
2dup > [
[ "must be no more than " % # ] "" make throw
] [
drop
] if ;
: v-regexp ( str what regexp -- str )
3dup nip matches?
[ 2drop ] [ drop "invalid " prepend throw ] if ;
: v-email ( str -- str )
#! From http://www.regular-expressions.info/email.html
320 v-max-length
"e-mail"
R' [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}'i
v-regexp ;
: v-url ( str -- str )
"URL" R' (?:ftp|http|https)://\S+' v-regexp ;
: v-captcha ( str -- str )
dup empty? [ "must remain blank" throw ] unless ;
: v-one-line ( str -- str )
v-required
dup "\r\n" intersects?
[ "must be a single line" throw ] when ;
: v-one-word ( str -- str )
v-required
dup [ alpha? ] all?
[ "must be a single word" throw ] unless ;
: v-username ( str -- str )
2 v-min-length 16 v-max-length v-one-word ;
: v-password ( str -- str )
6 v-min-length 40 v-max-length v-one-line ;
: v-mode ( str -- str )
dup mode-names member? [
"not a valid syntax mode" throw
] unless ;
: luhn? ( str -- ? )
string>digits <reversed>
[ odd? [ 2 * 10 /mod + ] when ] map-index
sum 10 divisor? ;
: v-credit-card ( str -- n )
"- " without
dup CHAR: 0 CHAR: 9 [a,b] diff empty? [
13 v-min-length
16 v-max-length
dup luhn? [ string>number ] [
"card number check failed" throw
] if
] [
"invalid credit card number format" throw
] if ;