From 833a78b16c5089cb6d3289a965f97b7c425627ab Mon Sep 17 00:00:00 2001 From: Andrew Tropin Date: Mon, 30 Aug 2021 12:17:11 +0300 Subject: home-services: Add utils module. * gnu/home-services/utils.scm (maybe-object->string object->snake-case-string) (object->snake-case-string): New variables. * gnu/local.mk (GNU_SYSTEM_MODULES): Add home-services/utils.scm. Signed-off-by: Oleg Pykhalov --- gnu/home-services/utils.scm | 77 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) create mode 100644 gnu/home-services/utils.scm (limited to 'gnu/home-services/utils.scm') diff --git a/gnu/home-services/utils.scm b/gnu/home-services/utils.scm new file mode 100644 index 0000000000..3e490a0515 --- /dev/null +++ b/gnu/home-services/utils.scm @@ -0,0 +1,77 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2021 Andrew Tropin +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu home-services utils) + #:use-module (ice-9 string-fun) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + + #:export (maybe-object->string + object->snake-case-string + object->camel-case-string)) + +(define (maybe-object->string object) + "Like @code{object->string} but don't do anyting if OBJECT already is +a string." + (if (string? object) + object + (object->string object))) + +;; Snake case: +(define* (object->snake-case-string object #:optional (style 'lower)) + "Convert the object OBJECT to the equivalent string in ``snake +case''. STYLE can be three `@code{lower}', `@code{upper}', or +`@code{capitalize}', defaults to `@code{lower}'. + +@example +(object->snake-case-string 'variable-name 'upper) +@result{} \"VARIABLE_NAME\" @end example" + (if (not (member style '(lower upper capitalize))) + (error 'invalid-style (format #f "~a is not a valid style" style)) + (let ((stringified (maybe-object->string object))) + (string-replace-substring + (cond + ((equal? style 'lower) stringified) + ((equal? style 'upper) (string-upcase stringified)) + (else (string-capitalize stringified))) + "-" "_")))) + +(define* (object->camel-case-string object #:optional (style 'lower)) + "Convert the object OBJECT to the equivalent string in ``camel case''. +STYLE can be three `@code{lower}', `@code{upper}', defaults to +`@code{lower}'. + +@example +(object->camel-case-string 'variable-name 'upper) +@result{} \"VariableName\" +@end example" + (if (not (member style '(lower upper))) + (error 'invalid-style (format #f "~a is not a valid style" style)) + (let ((stringified (maybe-object->string object))) + (cond + ((eq? style 'upper) + (string-concatenate + (map string-capitalize + (string-split stringified (cut eqv? <> #\-))))) + ((eq? style 'lower) + (let ((splitted-string (string-split stringified (cut eqv? <> #\-)))) + (string-concatenate + (cons (first splitted-string) + (map string-capitalize + (cdr splitted-string)))))))))) -- cgit v1.2.3