extra/verbal-expressions/verbal-expressions.factor

   1 ! Copyright (C) 2013 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors ascii assocs combinators.short-circuit fry
   5 grouping kernel make regexp sequences ;
   6
   7 IN: verbal-expressions
   8
   9 TUPLE: verbal-expression prefix source suffix modifiers ;
  10
  11 : <verbal-expressions> ( -- verbexp )
  12     "" "" "" "" verbal-expression boa ; inline
  13
  14 ALIAS: <verbexp> <verbal-expressions>
  15
  16 : >regexp ( verbexp -- regexp )
  17     [ [ prefix>> ] [ source>> ] [ suffix>> ] tri 3append ]
  18     [ modifiers>> ] bi <optioned-regexp> ; inline
  19
  20 : build-regexp ( ... quot: ( ... verbexp -- ... verbexp ) -- ... regexp )
  21     '[ <verbexp> @ >regexp ] call ; inline
  22
  23 <PRIVATE
  24
  25 : add ( verbexp str -- verbexp )
  26     '[ _ append ] change-source ;
  27
  28 : add-modifier ( verbexp ch -- verbexp )
  29     '[ _ suffix ] change-modifiers ;
  30
  31 : remove-modifier ( verbexp ch -- verbexp )
  32     '[ _ swap remove ] change-modifiers ;
  33
  34 : re-escape ( str -- str' )
  35     [
  36         [
  37             dup { [ Letter? ] [ digit? ] } 1||
  38             [ CHAR: \ , ] unless ,
  39         ] each
  40     ] "" make ;
  41
  42 PRIVATE>
  43
  44 : anything ( verbexp -- verbexp )
  45     "(?:.*)" add ;
  46
  47 : anything-but ( verbexp value -- verbexp )
  48     re-escape "(?:[^" "]*)" surround add ;
  49
  50 : something ( verbexp -- verbexp )
  51     "(?:.+)" add ;
  52
  53 : something-but ( verbexp value -- verbexp )
  54     re-escape "(?:[^" "]+)" surround add ;
  55
  56 : end-of-line ( verbexp -- verbexp )
  57     [ "$" append ] change-suffix ;
  58
  59 : maybe ( verbexp value -- verbexp )
  60     re-escape "(?:" ")?" surround add ;
  61
  62 : start-of-line ( verbexp -- verbexp )
  63     [ "^" append ] change-prefix ;
  64
  65 : -find- ( verbexp value -- verbexp )
  66     re-escape "(" ")" surround add ;
  67
  68 : then ( verbexp value -- verbexp )
  69     re-escape "(?:" ")" surround add ;
  70
  71 : any-of ( verbexp value -- verbexp )
  72     re-escape "(?:[" "])" surround add ;
  73
  74 : line-break ( verbexp -- verbexp )
  75     "(?:(?:\\n)|(?:\\r\\n))" add ;
  76
  77 ALIAS: br line-break
  78
  79 : range ( verbexp alist -- verbexp )
  80     [ [ re-escape ] bi@ "-" glue ] { } assoc>map concat
  81     "([" "])" surround add ;
  82
  83 : tab ( verbexp -- verbexp ) "\\t" add ;
  84
  85 : word ( verbexp -- verbexp ) "\\w+" add ;
  86
  87 : space ( verbexp -- verbexp ) "\\s" add ;
  88
  89 : many ( verbexp -- verbexp )
  90     [
  91         dup ?last "*+" member? [ "+" append ] unless
  92     ] change-source ;
  93
  94 : -or- ( verbexp -- verbexp )
  95     [ "(" append ] change-prefix
  96     [ ")|(" append ] change-source
  97     [ ")" prepend ] change-suffix ;
  98
  99 : case-insensitive ( verbexp -- verbexp )
 100     CHAR: i add-modifier ;
 101
 102 : case-sensitive ( verbexp -- verbexp )
 103     CHAR: i remove-modifier ;
 104
 105 : multiline ( verbexp -- verbexp )
 106     CHAR: m add-modifier ;
 107
 108 : singleline ( verbexp -- verbexp )
 109     CHAR: m remove-modifier ;
 110
 111 ALIAS: ^( start-of-line
 112 ALIAS: () then
 113 ALIAS: ()? maybe
 114 ALIAS: [] range
 115 ALIAS: ()* anything
 116 ALIAS: ^]* anything-but
 117 ALIAS: ()+ something
 118 ALIAS: [^]+ something-but
 119 ALIAS: )|( -or-
 120 ALIAS: )$ end-of-line