named-format.scm 3.7 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495
  1. ;;
  2. ;; Copyright 2022, Jaidyn Levesque <jadedctrl@posteo.at>
  3. ;;
  4. ;; This program is free software: you can redistribute it and/or
  5. ;; modify it under the terms of the GNU General Public License as
  6. ;; published by the Free Software Foundation, either version 3 of
  7. ;; the License, or (at your option) any later version.
  8. ;;
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;;
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  16. ;;
  17. ;; A simple module for making "template" strings á la `format` (but less flexible, more
  18. ;; broken, and based on named/keyed parameters rather than positional parameters).
  19. ;; TL;DR, "hi #{{role}}!!" instead of "hi ~A!!"
  20. ;; (Helper module for feedsnake.)
  21. (module named-format
  22. (named-format)
  23. (import scheme
  24. (chicken base) (chicken string)
  25. srfi-1 srfi-13 (only srfi-130 string-split)
  26. format)
  27. ;; Replaces all named "parameters" within a string with their associated values in the given alist.
  28. ;; A string with two parameters might look something like this:
  29. ;; "You're about to eat #{{food||rice}} for #{{cost}}! Bonne apetit!"
  30. ;; Whose parameter alist might look like this:
  31. ;; '((food "omlette") (cost "$9.00"))
  32. ;; If you don't specify a parameter's value in the alist, it's #{{mention}} in the string will just
  33. ;; be removed, or replaced with a default value, if provided like so:
  34. ;; #{{food||rice}}
  35. ;; has a default value of "rice".
  36. (define (named-format string parameter-alist)
  37. (replace-parameters string
  38. parameter-alist
  39. (reverse (string-contains-all string "~{{" 0))
  40. #f))
  41. ;; Replaces the parameter mentions in the given string at the given indices with their
  42. ;; associated alist values. The `parameter-indices` list must be given in reverse order
  43. ;; (e.g., 100, 99, 73).
  44. (define (replace-parameters string parameters parameter-indices previous-index)
  45. (let* ([index (car parameter-indices)]
  46. [next-index (if (null? (cdr parameter-indices))
  47. #f
  48. (cadr parameter-indices))]
  49. [substituted
  50. (replace-parameter string parameters index (or previous-index (string-length string)))])
  51. (if next-index
  52. (replace-parameters substituted parameters (cdr parameter-indices) index)
  53. substituted)))
  54. ;; Substitute a single string's parameter beginning at the given index.
  55. ;; This is bad, I'm genuinely ashamed. Please forgive me ;-;
  56. (define (replace-parameter string parameters index max-index)
  57. (let* ([end-of-substitution (+ 2 (string-contains string "}}" index max-index))]
  58. [columns (string-split
  59. (string-copy string (+ 3 index) (- end-of-substitution 2))
  60. "||")]
  61. [key-symbols (map string->symbol (cddr columns))]
  62. [values (filter (lambda (a) a)
  63. (map (lambda (key)
  64. (let ([value (alist-ref key parameters)])
  65. (if value (car value) #f)))
  66. key-symbols))]
  67. [value (if (null? values)
  68. (cadr columns)
  69. (car values))]
  70. [formatting (if (and (string? value) (string-null? value))
  71. "~A"
  72. (car columns))])
  73. (string-replace string (format formatting value) index end-of-substitution)))
  74. ;; A list of all instances of a substring within a string, by index
  75. (define (string-contains-all string needle from-index)
  76. (let* ([match-index (string-contains string needle from-index)]
  77. [next-match-index (string-contains string needle (+ 1 match-index))])
  78. (if next-match-index
  79. (append (list match-index)
  80. (string-contains-all string needle (+ 1 match-index)))
  81. (list match-index))))
  82. ) ;; named-format module