basis/escape-strings/escape-strings.factor

   1 ! Copyright (C) 2017 John Benediktsson, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs assocs.extras combinators kernel math math.order
   4 math.statistics sequences sequences.extras sets ;
   5 IN: escape-strings
   6
   7 : find-escapes ( str -- set )
   8     [ HS{ } clone 0 0 ] dip
   9     [
  10         {
  11             { CHAR: ] [ 1 + dup 2 = [ drop over adjoin 0 1 ] when ] }
  12             { CHAR: = [ dup 1 = [ [ 1 + ] dip ] when ] }
  13             [ 3drop 0 0 ]
  14         } case
  15     ] each 0 > [ over adjoin ] [ drop ] if ;
  16
  17 : lowest-missing ( set -- min )
  18     members dup [ = not ] find-index
  19     [ nip ] [ drop length ] if ;
  20
  21 : escape-string* ( str n -- str' )
  22     CHAR: = <repetition>
  23     [ "[" dup surround ] [ "]" dup surround ] bi surround ;
  24
  25 : escape-string ( str -- str' )
  26     dup find-escapes lowest-missing escape-string* ;
  27
  28 : escape-strings ( strs -- str )
  29     [ escape-string ] map concat escape-string ;
  30
  31 : tag-payload ( str tag -- str' )
  32     [ escape-string ] dip prepend ;
  33
  34 : escape-simplest ( str -- str' )
  35     dup { CHAR: ' CHAR: " CHAR: \r CHAR: \n CHAR: \s } counts {
  36         ! { [ dup { CHAR: ' CHAR: \r CHAR: \n CHAR: \s } values-of sum 0 = ] [ drop "'" prepend ] }
  37         { [ dup CHAR: " of not ] [ drop "\"" "\"" surround ] }
  38         [ drop escape-string ]
  39     } cond ;