]> gitweb.factorcode.org Git - factor.git/commitdiff
tokencase: adding token case conversions
authorJohn Benediktsson <mrjbq7@gmail.com>
Wed, 27 Jul 2022 22:08:18 +0000 (15:08 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Wed, 27 Jul 2022 22:08:18 +0000 (15:08 -0700)
extra/tokencase/authors.txt [new file with mode: 0644]
extra/tokencase/tokencase-tests.factor [new file with mode: 0644]
extra/tokencase/tokencase.factor [new file with mode: 0644]

diff --git a/extra/tokencase/authors.txt b/extra/tokencase/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/tokencase/tokencase-tests.factor b/extra/tokencase/tokencase-tests.factor
new file mode 100644 (file)
index 0000000..d182c49
--- /dev/null
@@ -0,0 +1,15 @@
+USING: tokencase tools.test ;
+
+{ "myNameIsFactor" } [ "My-name.Is_Factor" >camelcase ] unit-test
+{ "MyNameIsFactor" } [ "My-name.Is_Factor" >pascalcase ] unit-test
+{ "my_name_is_factor" } [ "My-name.Is_Factor" >snakecase ] unit-test
+{ "My_Name_Is_Factor" } [ "My-name.Is_Factor" >adacase ] unit-test
+{ "MY_NAME_IS_FACTOR" } [ "My-name.Is_Factor" >macrocase ] unit-test
+{ "my-name-is-factor" } [ "My-name.Is_Factor" >kebabcase ] unit-test
+{ "My-Name-Is-Factor" } [ "My-name.Is_Factor" >traincase ] unit-test
+{ "MY-NAME-IS-FACTOR" } [ "My-name.Is_Factor" >cobolcase ] unit-test
+{ "my name is factor" } [ "My-name.Is_Factor" >lowercase ] unit-test
+{ "MY NAME IS FACTOR" } [ "My-name.Is_Factor" >uppercase ] unit-test
+{ "My Name Is Factor" } [ "My-name.Is_Factor" >titlecase ] unit-test
+{ "My name is factor" } [ "My-name.Is_Factor" >sentencecase ] unit-test
+{ "my.name.is.factor" } [ "My-name.Is_Factor" >dotcase ] unit-test
diff --git a/extra/tokencase/tokencase.factor b/extra/tokencase/tokencase.factor
new file mode 100644 (file)
index 0000000..226dd3d
--- /dev/null
@@ -0,0 +1,63 @@
+! Copyright (C) 2022 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: combinators kernel sequences splitting strings unicode ;
+
+IN: tokencase
+
+<PRIVATE
+
+: case-index ( str -- i/f )
+    dup [ 1string lower? ] find drop [
+        over [ 1string lower? not ] find-from drop
+        [ nip ] [ length ] if*
+    ] [ length ] if* ;
+
+: split-case ( str -- words )
+    [ dup empty? not ] [
+        dup case-index
+        [ cut-slice swap ]
+        [ f 0 rot [ length ] keep <slice> ] if*
+    ] produce nip ;
+
+: split-tokens ( str -- words )
+    " -_." split [ split-case ] map concat ;
+
+: case1 ( str quot glue -- str' )
+    [ split-tokens ] [ map ] [ join ] tri* ; inline
+
+: case2 ( str first-quot rest-quot glue -- str' )
+    {
+        [ split-tokens 0 over ]
+        [ change-nth dup rest-slice ]
+        [ map! drop ]
+        [ join ]
+    } spread ; inline
+
+PRIVATE>
+
+: >camelcase ( str -- str' ) [ >lower ] [ >title ] "" case2 ;
+
+: >pascalcase ( str -- str' ) [ >title ] "" case1 ;
+
+: >snakecase ( str -- str' ) [ >lower ] "_" case1 ;
+
+: >adacase ( str -- str' ) [ >title ] "_" case1 ;
+
+: >macrocase ( str -- str' ) [ >upper ] "_" case1 ;
+
+: >kebabcase ( str -- str' ) [ >lower ] "-" case1 ;
+
+: >traincase ( str -- str' ) [ >title ] "-" case1 ;
+
+: >cobolcase ( str -- str' ) [ >upper ] "-" case1 ;
+
+: >lowercase ( str -- str' ) [ >lower ] " " case1 ;
+
+: >uppercase ( str -- str' ) [ >upper ] " " case1 ;
+
+: >titlecase ( str -- str' ) [ >title ] " " case1 ;
+
+: >sentencecase ( str -- str' ) [ >title ] [ >lower ] " " case2 ;
+
+: >dotcase ( str -- str' ) [ >lower ] "." case1 ;