contrib/furnace/validator.factor

   1 ! Copyright (C) 2006 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: furnace
   4 USING: generic kernel errors words sequences math
   5 namespaces ;
   6
   7 TUPLE: validation-error reason ;
   8
   9 : apply-validators ( string quot -- obj error/f )
  10     [
  11         call f
  12     ] [
  13         dup validation-error? [ >r 2drop f r> ] [ rethrow ] if
  14     ] recover ;
  15
  16 : validation-error ( msg -- * ) <validation-error> throw ;
  17
  18 : v-default ( obj value -- obj )
  19     over empty? [ nip ] [ drop ] if ;
  20
  21 : v-required ( str -- str )
  22     dup empty? [ "required" validation-error ] when ;
  23
  24 : v-min-length ( str n -- str )
  25     over length over < [
  26         [ "must be at least " % # " characters" % ] "" make
  27         validation-error
  28     ] [
  29         drop
  30     ] if ;
  31
  32 : v-max-length ( str n -- str )
  33     over length over > [
  34         [ "must be no more than " % # " characters" % ] "" make
  35         validation-error
  36     ] [
  37         drop
  38     ] if ;
  39
  40 : v-number ( str -- n )
  41     string>number [
  42         "must be a number" validation-error
  43     ] unless* ;