utils.scm 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
  3. ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
  4. ;;;
  5. ;;; This file is part of GNU Guix.
  6. ;;;
  7. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  8. ;;; under the terms of the GNU General Public License as published by
  9. ;;; the Free Software Foundation; either version 3 of the License, or (at
  10. ;;; your option) any later version.
  11. ;;;
  12. ;;; GNU Guix is distributed in the hope that it will be useful, but
  13. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;;; GNU General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  19. (define-module (gnu home services utils)
  20. #:use-module (ice-9 string-fun)
  21. #:use-module (srfi srfi-1)
  22. #:use-module (srfi srfi-26)
  23. #:export (maybe-object->string
  24. object->snake-case-string
  25. object->camel-case-string
  26. list->human-readable-list))
  27. (define (maybe-object->string object)
  28. "Like @code{object->string} but don't do anything if OBJECT already is
  29. a string."
  30. (if (string? object)
  31. object
  32. (object->string object)))
  33. ;; Snake case: <https://en.wikipedia.org/wiki/Snake_case>
  34. (define* (object->snake-case-string object #:optional (style 'lower))
  35. "Convert the object OBJECT to the equivalent string in ``snake
  36. case''. STYLE can be three `@code{lower}', `@code{upper}', or
  37. `@code{capitalize}', defaults to `@code{lower}'.
  38. @example
  39. (object->snake-case-string 'variable-name 'upper)
  40. @result{} \"VARIABLE_NAME\" @end example"
  41. (if (not (member style '(lower upper capitalize)))
  42. (error 'invalid-style (format #f "~a is not a valid style" style))
  43. (let ((stringified (maybe-object->string object)))
  44. (string-replace-substring
  45. (cond
  46. ((equal? style 'lower) stringified)
  47. ((equal? style 'upper) (string-upcase stringified))
  48. (else (string-capitalize stringified)))
  49. "-" "_"))))
  50. (define* (object->camel-case-string object #:optional (style 'lower))
  51. "Convert the object OBJECT to the equivalent string in ``camel case''.
  52. STYLE can be three `@code{lower}', `@code{upper}', defaults to
  53. `@code{lower}'.
  54. @example
  55. (object->camel-case-string 'variable-name 'upper)
  56. @result{} \"VariableName\"
  57. @end example"
  58. (if (not (member style '(lower upper)))
  59. (error 'invalid-style (format #f "~a is not a valid style" style))
  60. (let ((stringified (maybe-object->string object)))
  61. (cond
  62. ((eq? style 'upper)
  63. (string-concatenate
  64. (map string-capitalize
  65. (string-split stringified (cut eqv? <> #\-)))))
  66. ((eq? style 'lower)
  67. (let ((splitted-string (string-split stringified (cut eqv? <> #\-))))
  68. (string-concatenate
  69. (cons (first splitted-string)
  70. (map string-capitalize
  71. (cdr splitted-string))))))))))
  72. (define* (list->human-readable-list lst
  73. #:key
  74. (cumulative? #f)
  75. (proc identity))
  76. "Turn a list LST into a sequence of terms readable by humans.
  77. If CUMULATIVE? is @code{#t}, use ``and'', otherwise use ``or'' before
  78. the last term.
  79. PROC is a procedure to apply to each of the elements of a list before
  80. turning them into a single human readable string.
  81. @example
  82. (list->human-readable-list '(1 4 9) #:cumulative? #t #:proc sqrt)
  83. @result{} \"1, 2, and 3\"
  84. @end example
  85. yields:"
  86. (let* ((word (if cumulative? "and " "or "))
  87. (init (append (drop-right lst 1))))
  88. (format #f "~a" (string-append
  89. (string-join
  90. (map (compose maybe-object->string proc) init)
  91. ", " 'suffix)
  92. word
  93. (maybe-object->string (proc (last lst)))))))