extra/tokencase/tokencase.factor

   1 ! Copyright (C) 2022 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: combinators kernel sequences splitting strings unicode ;
   5
   6 IN: tokencase
   7
   8 <PRIVATE
   9
  10 : case-index ( str -- i/f )
  11     dup [ lower? ] find drop [
  12         over [ lower? not ] find-from drop
  13         [ nip ] [ length ] if*
  14     ] [ length ] if* ;
  15
  16 : split-case ( str -- words )
  17     >graphemes [ dup empty? not ] [
  18         dup case-index
  19         [ cut-slice swap ]
  20         [ f 0 rot [ length ] keep <slice> ] if* concat
  21     ] produce nip ;
  22
  23 : split-tokens ( str -- words )
  24     " -_." split [ split-case ] map concat ;
  25
  26 : case1 ( str quot glue -- str' )
  27     [ split-tokens ] [ map ] [ join ] tri* ; inline
  28
  29 : case2 ( str first-quot rest-quot glue -- str' )
  30     {
  31         [ split-tokens 0 over ]
  32         [ change-nth dup rest-slice ]
  33         [ map! drop ]
  34         [ join ]
  35     } spread ; inline
  36
  37 PRIVATE>
  38
  39 : >camelcase ( str -- str' ) [ >lower ] [ >title ] "" case2 ;
  40
  41 : >pascalcase ( str -- str' ) [ >title ] "" case1 ;
  42
  43 : >snakecase ( str -- str' ) [ >lower ] "_" case1 ;
  44
  45 : >adacase ( str -- str' ) [ >title ] "_" case1 ;
  46
  47 : >macrocase ( str -- str' ) [ >upper ] "_" case1 ;
  48
  49 : >kebabcase ( str -- str' ) [ >lower ] "-" case1 ;
  50
  51 : >traincase ( str -- str' ) [ >title ] "-" case1 ;
  52
  53 : >cobolcase ( str -- str' ) [ >upper ] "-" case1 ;
  54
  55 : >lowercase ( str -- str' ) [ >lower ] " " case1 ;
  56
  57 : >uppercase ( str -- str' ) [ >upper ] " " case1 ;
  58
  59 : >titlecase ( str -- str' ) [ >title ] " " case1 ;
  60
  61 : >sentencecase ( str -- str' ) [ >title ] [ >lower ] " " case2 ;
  62
  63 : >dotcase ( str -- str' ) [ >lower ] "." case1 ;