string-utils.scm 2.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990
  1. (library (string-utils)
  2. (export char->string
  3. string->char
  4. has-prefix?
  5. has-suffix?
  6. remove-prefix
  7. remove-suffix
  8. remove-multiple-prefix
  9. remove-multiple-suffix)
  10. (import
  11. (except (rnrs base) let-values)
  12. (only (guile)
  13. ;; lambda forms
  14. lambda* λ
  15. ;; file system stuff
  16. ;; string stuff
  17. string-null?
  18. string-trim-right
  19. string-split
  20. string-contains
  21. string-suffix-length
  22. string-prefix-length)
  23. (ice-9 exceptions)
  24. (prefix (logging) log:))
  25. (define char->string
  26. (λ (c)
  27. (list->string
  28. (list c))))
  29. (define string->char
  30. (λ (str)
  31. "Convert a string, which has only one single character
  32. into a character. This is useful, because some functions
  33. expect a characters as input instead of a string."
  34. (cond
  35. [(= (string-length str) 1)
  36. (car (string->list str))]
  37. [else
  38. (raise-exception
  39. (make-exception
  40. (make-non-continuable-error)
  41. (make-exception-with-message "trying to convert string of more than 1 character to char")
  42. (make-exception-with-irritants (list str))
  43. (make-exception-with-origin 'string->char)))])))
  44. (define has-prefix?
  45. (λ (str prefix)
  46. (= (string-prefix-length str prefix)
  47. (string-length prefix))))
  48. (define has-suffix?
  49. (λ (str suffix)
  50. (= (string-suffix-length str suffix)
  51. (string-length suffix))))
  52. (define remove-prefix
  53. (λ (str prefix)
  54. (cond
  55. [(has-prefix? str prefix)
  56. (substring str (string-length prefix))]
  57. [else str])))
  58. (define remove-suffix
  59. (λ (str suffix)
  60. (cond
  61. [(has-suffix? str suffix)
  62. (substring str
  63. 0
  64. (- (string-length str)
  65. (string-length suffix)))]
  66. [else str])))
  67. (define remove-multiple-prefix
  68. (λ (str prefix)
  69. (cond
  70. [(has-prefix? str prefix)
  71. (remove-multiple-prefix (substring str (string-length prefix))
  72. prefix)]
  73. [else str])))
  74. (define remove-multiple-suffix
  75. (λ (str suffix)
  76. (cond
  77. [(has-suffix? str suffix)
  78. (remove-multiple-suffix (substring str 0 (- (string-length str)
  79. (string-length suffix)))
  80. suffix)]
  81. [else str]))))