guile-user-input-output/message-builder.scm

(library (message-builder)
  (export choices->message
          build-prompt-string)
  (import
   (except (rnrs base) let-values map error)
   (only (guile)
         ;; lambda forms
         lambda* λ
         display
         ;; control flow
         when
         ;; string
         string-join
         ;; display
         simple-format
         ;; ports
         call-with-output-string)
   ;; lists
   (srfi srfi-1)))


(define rest
  (λ (lst)
    "alias for cdr"
    (cdr lst)))


(define build-prompt-string
  (lambda* (prompt-text
            #:key
            (choices #f)
            (choices-opener "[")
            (choices-separator "/")
            (choices-closer "]")
            (input-separator ": "))
    "Construct the string, which is displayed before the
cursor of an input."
    (call-with-output-string
      (λ (string-port)
        (when prompt-text
          (display prompt-text string-port))

        (when (and prompt-text choices)
          (display " " string-port))

        (when choices
          (display choices-opener string-port)
          (display (string-join choices choices-separator) string-port)
          (display choices-closer string-port))

      (display input-separator string-port)))))


(define choices->message
  (lambda* (choices
            choice-texts
            #:key (separator ":") (spacer " ") (choice-end "\n") (end ""))
    "Transform choices into a string message, ready to be
shown to a user supposed to make a choice."
    (call-with-output-string
      (λ (string-port)
        (let next-choice ([rest-choices choices] [rest-choice-texts choice-texts])
          (cond
           [(null? rest-choices)
            (display end string-port)]
           [else
            (simple-format string-port
                           "~a~a~a~a~a"
                           (first rest-choices)
                           separator
                           spacer
                           (first rest-choice-texts)
                           choice-end)
            (next-choice (cdr rest-choices)
                         (cdr rest-choice-texts))]))))))