summaryrefslogtreecommitdiff
path: root/gnu/home/services/utils.scm
diff options
context:
space:
mode:
authorOleg Pykhalov <go.wigust@gmail.com>2021-10-05 02:09:41 +0300
committerOleg Pykhalov <go.wigust@gmail.com>2021-10-08 15:36:18 +0300
commitba8ddb348045f81f061a1c7f51c0f7c2b0024e71 (patch)
tree58feeca8579cccff3451a37ff0ef634e16f5b9c4 /gnu/home/services/utils.scm
parent2e74616446ba6cc554547436e848637e7f61cb32 (diff)
downloadguix-patches-ba8ddb348045f81f061a1c7f51c0f7c2b0024e71.tar
guix-patches-ba8ddb348045f81f061a1c7f51c0f7c2b0024e71.tar.gz
gnu: Move (gnu home-services) to (gnu home services).
* gnu/home-services/configuration.scm: Move the content ... * gnu/home/services/configuration.scm: ... here. * doc/guix.texi: Replace (gnu home-services mcron) with (gnu home services mcron). Replace (gnu home-services) with (gnu home services). * gnu/home.scm: Replace (gnu home-services fontutils) with (gnu services fontutils). Replace (gnu home-services shells) with (gnu home services shells). Replace (gnu home-services symlink-manager) with (gnu home services symlink-manager). Replace (gnu home-services xdg) with (gnu home services xdg). * gnu/home-services/fontutils.scm: Rename to gnu/services/fontutils.scm. * gnu/home-services/mcron.scm: Move to gnu/home/services/mcron.scm. Replace (gnu home-services shepherd) with (gnu home services shepherd). * gnu/home-services.scm (%service-type-path): Search home services in "gnu/services". * gnu/home-services/shells.scm: Replace (gnu home-services configuration) with (gnu home services configuration). Rename to gnu/home/services/shells.scm. Replace (gnu home-services utils) with (gnu home services utils). * gnu/home-services/shepherd.scm: Move to gnu/home/services/shepherd.scm. * gnu/home-services/symlink-manager.scm: Rename to gnu/home/services/symlink-manager.scm. * gnu/home-services/utils.scm: Rename to gnu/home/services/utils.scm. * gnu/home-services/xdg.scm: Rename to gnu/home/services/xdg.scm. * guix/scripts/home/import.scm: Replace (gnu home-services bash) with (gnu home services bash). * gnu/home-services.scm: Update documentation string. * doc/he-config-bare-bones.scm: Apply new (gnu home-services ...) modules location. * gnu/local.mk (GNU_SYSTEM_MODULES): Same.
Diffstat (limited to 'gnu/home/services/utils.scm')
-rw-r--r--gnu/home/services/utils.scm105
1 files changed, 105 insertions, 0 deletions
diff --git a/gnu/home/services/utils.scm b/gnu/home/services/utils.scm
new file mode 100644
index 0000000000..cea75ee896
--- /dev/null
+++ b/gnu/home/services/utils.scm
@@ -0,0 +1,105 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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
+ list->human-readable-list))
+
+(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: <https://en.wikipedia.org/wiki/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))))))))))
+
+(define* (list->human-readable-list lst
+ #:key
+ (cumulative? #f)
+ (proc identity))
+ "Turn a list LST into a sequence of terms readable by humans.
+If CUMULATIVE? is @code{#t}, use ``and'', otherwise use ``or'' before
+the last term.
+
+PROC is a procedure to apply to each of the elements of a list before
+turning them into a single human readable string.
+
+@example
+(list->human-readable-list '(1 4 9) #:cumulative? #t #:proc sqrt)
+@result{} \"1, 2, and 3\"
+@end example
+
+yields:"
+ (let* ((word (if cumulative? "and " "or "))
+ (init (append (drop-right lst 1))))
+ (format #f "~a" (string-append
+ (string-join
+ (map (compose maybe-object->string proc) init)
+ ", " 'suffix)
+ word
+ (maybe-object->string (proc (last lst)))))))
+