factor: trim using lists

[factor.git] / basis / escape-strings / escape-strings.factor

diff --git a/basis/escape-strings/escape-strings.factor b/basis/escape-strings/escape-strings.factor
index 09fe48836c68ebd8b5a1ff2926ad68b0508e0a4e..5b6e6c1f6df133cf3c5c369b112ccb320885d4d4 100644 (file)
--- a/basis/escape-strings/escape-strings.factor
+++ b/basis/escape-strings/escape-strings.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2017 John Benediktsson, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs assocs.extras combinators kernel math math.order
-math.statistics sequences sequences.extras sets ;
+USING: ascii assocs checksums checksums.sha combinators
+kernel math math.functions math.parser ranges
+math.statistics sequences sets sorting splitting strings uuid ;
 IN: escape-strings
 
 : find-escapes ( str -- set )
@@ -14,26 +15,80 @@ IN: escape-strings
         } case
     ] each 0 > [ over adjoin ] [ drop ] if ;
 
+: find-number-escapes ( str -- set )
+    [ HS{ } clone SBUF" " clone 0 ] dip
+    [
+        {
+            { [ dup CHAR: ] = ] [
+                drop 1 + dup 2 = [
+                    drop dup >string pick adjoin
+                    0 over set-length 1
+                ] when
+            ] }
+            { [ dup digit? ] [ [ dup 1 = ] dip '[ [ _ over push ] dip ] [ ] if ] }
+            [ 2drop 0 over set-length 0 ]
+        } cond
+    ] each 0 > [ >string over adjoin ] [ drop ] if ;
+
+: lowest-missing-number ( string-set -- min )
+    members dup
+    [ length ] histogram-by
+    dup keys length [0..b]
+    [ [ of ] keep over [ 10^ < ] [ nip ] if ] with find nip
+    [ '[ length _ = ] filter natural-sort ] keep ! remove natural-sort here
+    [
+        [ drop "" ] [
+            10^ <iota> [
+                [ swap ?nth dup [ string>number ] when ] keep = not
+            ] with find nip number>string
+        ] if-zero
+    ] keep CHAR: 0 pad-head ;
+
 : lowest-missing ( set -- min )
     members dup [ = not ] find-index
     [ nip ] [ drop length ] if ;
 
-: escape-string* ( str n -- str' )
-    CHAR: = <repetition>
-    [ "[" dup surround ] [ "]" dup surround ] bi surround ;
+: surround-by-brackets ( str delim -- str' )
+    [ "[" 1surround ] [ "]" 1surround ] bi surround ;
+
+: surround-by-equals-brackets ( str n -- str' )
+    CHAR: = <repetition> surround-by-brackets ;
 
 : escape-string ( str -- str' )
-    dup find-escapes lowest-missing escape-string* ;
+    dup find-escapes lowest-missing surround-by-equals-brackets ;
 
 : escape-strings ( strs -- str )
     [ escape-string ] map concat escape-string ;
 
+: number-escape-string ( str -- str' )
+    dup find-number-escapes lowest-missing-number surround-by-brackets ;
+
+: number-escape-strings ( strs -- str )
+    [ number-escape-string ] map concat number-escape-string ;
+
 : tag-payload ( str tag -- str' )
     [ escape-string ] dip prepend ;
 
 : escape-simplest ( str -- str' )
-    dup { CHAR: ' CHAR: " CHAR: \r CHAR: \n CHAR: \s } counts {
+    dup histogram {
         ! { [ dup { CHAR: ' CHAR: \r CHAR: \n CHAR: \s } values-of sum 0 = ] [ drop "'" prepend ] }
         { [ dup CHAR: " of not ] [ drop "\"" "\"" surround ] }
         [ drop escape-string ]
     } cond ;
+
+: uuid1-escape-string ( str -- str' ) uuid1 surround-by-brackets ;
+: uuid4-escape-string ( str -- str' ) uuid4 surround-by-brackets ;
+
+: sha1-escape-string ( str -- str' )
+    [ ] [ sha1 checksum-bytes bytes>hex-string ] bi surround-by-brackets ;
+
+: sha256-escape-string ( str -- str' )
+    [ ] [ sha-256 checksum-bytes bytes>hex-string ] bi surround-by-brackets ;
+
+GENERIC: sha1-escape-strings ( obj -- strs )
+
+M: sequence sha1-escape-strings ( seq -- strs )
+    [ sha1-escape-string ] { } map-as ;
+
+M: string sha1-escape-strings ( str -- strs )
+    split-lines sha1-escape-strings ;