Guile | How to parse a file?

Question

I am trying to figure out how to manipulate variables of a guile script through a config file, instead of having to edit the source code.

Got a file called test.cfg that contains this:

name = Gareth
my-num = 123
rand-string = Hello, world!

Here is a script named read-file that I have so far:

#!/usr/bin/guile \
-e main -s
!#

(use-modules (ice-9 textual-ports))

(define (read-file file)
  (call-with-input-file file
    (lambda (port)
      (get-string-all port))))

(define get-name
  (call-with-input-file "test.cfg"
    ;; Code to get value of `name` from test.cfg here.
    ))

(define (main args)
  (display (read-file "test.cfg"))
  (display (get-name))
  (newline))

In the end result, when name is changed in test.cfg, get-name in read-file should return the new value.

Answer 1

I made a small parser, this was an interesting excercise, this should help you parse this format directly, although it is a bit rudimentary.

;;; Helper Functions

(define (ok value)
  (cons 'none value))

(define (err message)
  (cons message 'none))

(define (is-err result)
  (not (eq? (car result) 'none)))

(define (unwrap result)
  (if (is-err result)
      (error "Attempted to unwrap an error:" (car result))
      (cdr result)))

(define (err-map result f)
  (if (is-err result)
      (err (f (car result)))
      result))

(define (ok-map result f)
  (if (is-err result)
      result
      (ok (f (cdr result)))))

(define (replace-with-error result default-value)
  (if (is-err result)
      default-value
      (cdr result)))

;;; String Conversion Helpers (Consolidated)

(define (list->string lst)
  (let loop ((lst lst) (result ""))
    (if (null? lst)
        result
        (loop (cdr lst) (string-append result (string (car lst)))))))

(define (list->string-converter lst)
    (cond
      ((null? lst) "")  ; If the list is empty, return an empty string
      ((char? (car lst))  ; If the first element is a character, use list->string
       (list->string lst))
      ((string? (car lst))  ; If the first element is a string, use string-append
       (apply string-append lst))
      (else
       (error "Invalid list: contains elements that are neither characters nor strings"))))

;;; Basic Parsers

(define (optional-parser parser)
  (lambda (str)
    (let ((parsed-result (parser str)))
      (if (is-err parsed-result)
          (ok (cons "" str))
          parsed-result))))

(define (concatenate-parser . parsers)
  (lambda (str)
    (let loop ((results '())
               (current-remaining str)
               (parsers parsers))
      (if (null? parsers)
          (ok (cons results current-remaining))
          (let ((parsed-result ((car parsers) current-remaining)))
            (if (is-err parsed-result)
                (err-map parsed-result (lambda (err) (cons (cons err results) current-remaining)))
                (let ((unwrapped-result (unwrap parsed-result)))
                  (loop (append results (list (car unwrapped-result)))
                        (cdr unwrapped-result)
                        (cdr parsers)))))))))

(define (choice-parser parsers)
  (lambda (str)
    (let loop ((parsers parsers))
      (if (null? parsers)
          (err (cons "All choices failed in choiceParser" str))
          (let ((parsed-result ((car parsers) str)))
            (if (is-err parsed-result)
                (loop (cdr parsers))
                parsed-result))))))

(define (backtrack-parser choices subsequent-parser)
  (lambda (str)
    (let loop ((choices choices)
               (error-messages '()))
      (if (null? choices)
          (err (cons "Backtrack parser failed with errors:" (cons error-messages str)))
          (let ((choice-result ((car choices) str)))
            (if (is-err choice-result)
                (loop (cdr choices) (cons (cons "Choice parser failed:" (car choice-result)) error-messages))
                (let ((subsequent-result (subsequent-parser (cdr (unwrap choice-result)))))
                  (if (is-err subsequent-result)
                      (loop (cdr choices) (cons (cons "Subsequent parser failed:" (car subsequent-result)) error-messages))
                      (ok (cons (car (unwrap choice-result)) (unwrap subsequent-result)))))))))))

(define (map-parser parser transform)
  (lambda (str)
    (let ((parsed-result (parser str)))
      (if (is-err parsed-result)
          parsed-result
          (let ((unwrapped-result (unwrap parsed-result)))
            (ok (cons (transform (car unwrapped-result)) ; Transform the parsed value
                      (cdr unwrapped-result))))))))      ; Keep the remaining string unchanged

(define (bubble-parser parser)
  (lambda (str)
    (let ((parsed-result (parser str)))
      (if (is-err parsed-result)
          parsed-result
          (ok (cons (car (unwrap parsed-result)) ""))))))

(define (drop-parser parser)
  (lambda (str)
    (let ((result (parser str)))
      (if (is-err result)
          result
          (ok (cons 'none (cdr (unwrap result))))))))

(define (sandwich bread1 filling bread2)
  (bubble-parser
   (concatenate-parser
    (drop-parser bread1)
    filling
    (drop-parser bread2))))

(define (bind-parser parser binder-function)
  (lambda (str)
    (let ((parsed-result (parser str)))
      (if (is-err parsed-result)
          (err (cons "Initial parser failed in bindParser with error:" (cons (car parsed-result) str)))
          (let ((unwrapped-result (unwrap parsed-result)))
            (let ((next-parser (binder-function (car unwrapped-result))))
              (let ((next-parsed-result (next-parser (cdr unwrapped-result))))
                (if (is-err next-parsed-result)
                    (err (cons "Subsequent parser failed in bindParser following successful initial parse."
                               (cons (car next-parsed-result) str)))
                    next-parsed-result))))))))

(define (take n)
  (lambda (str)
    (if (>= (string-length str) n)
        (ok (cons (substring str 0 n) (substring str n)))
        (err (cons (string-append "take parser failed: string shorter than " (number->string n) " characters")
                   str)))))

(define (invert-parser parser)
  (lambda (str)
    (let ((parsed-result (parser str)))
      (if (is-err parsed-result)
          (ok (cons 'none str))
          (err (cons "invertParser failed: provided parser succeeded" str))))))

(define (tag-parser name parser)
  (lambda (str)
    (err-map (map-parser parser (lambda (content) (cons name content))) str)))

(define (unshift-parser item list-parser)
  (map-parser (concatenate-parser item list-parser)
              (lambda (a) (cons (car a) (cdr a)))))


;;; Character Parsers
(define (whitespace-parser string)
  (if (and (not (string-null? string))
           (char-whitespace? (string-ref string 0)))
      (let ((whitespace-char (string-ref string 0))
            (remaining (substring string 1)))
        (ok (cons whitespace-char remaining)))
      (err "Expected a whitespace character")))

(define (digit-parser string)
  (if (and (not (string-null? string))
           (char-numeric? (string-ref string 0)))
      (let ((digit (string-ref string 0))
            (remaining (substring string 1)))
        (ok (cons digit remaining)))
      (err "Expected a digit")))

(define (uppercase-parser string)
  (if (and (not (string-null? string))
           (char-upper-case? (string-ref string 0)))
      (let ((char (string-ref string 0))
            (remaining (substring string 1)))
        (ok (cons char remaining)))
      (err "Expected an uppercase letter (A-Z)")))

(define (lowercase-parser string)
  (if (and (not (string-null? string))
           (char-lower-case? (string-ref string 0)))
      (let ((char (string-ref string 0))
            (remaining (substring string 1)))
        (ok (cons char remaining)))
      (err "Expected a lowercase letter (a-z)")))

(define (exact-char-parser expected-char)
  (lambda (str)
    (if (and (not (string-null? str)) ; Check if the string is not empty
             (char=? (string-ref str 0) expected-char)) ; Check if the first character matches
        (ok (cons expected-char (substring str 1))) ; Return the character and remaining string
        (err (string-append "Expected character: " (string expected-char)))))) ; Error message


;;; Repetition Parsers

(define (repeat0-parser parser)
  (lambda (str)
    (let loop ((result '()) (remaining str))
      (let ((parsed-result (parser remaining)))
        (if (is-err parsed-result)
            (ok (cons (reverse result) remaining)) ; Return collected results and remaining string
            (let ((unwrapped-result (unwrap parsed-result)))
              (loop (cons (car unwrapped-result) result) ; Add parsed value to result list
                    (cdr unwrapped-result))))))))        ; Update remaining string


(define (repeat1-parser parser)
  (lambda (str)
    (let ((first-result (parser str))) ; Try to parse at least once
      (if (is-err first-result)
          first-result ; Return the error if the first parse fails
          (let loop ((result (list (car (unwrap first-result)))) ; Start with the first parsed value
                     (remaining (cdr (unwrap first-result))))    ; Update remaining string
            (let ((parsed-result (parser remaining)))
              (if (is-err parsed-result)
                  (ok (cons (reverse result) remaining)) ; Return collected results and remaining string
                  (loop (cons (car (unwrap parsed-result)) result) ; Add parsed value to result list
                        (cdr (unwrap parsed-result))))))))))       ; Update remaining string

;;; Specific Token Parsers
(define (exact-parser literal)
  (lambda (string)
    (if (string-prefix? literal string)
        (let ((remaining (substring string (string-length literal))))
          (ok (cons literal remaining)))
        (err (string-append "Exact match failed for literal: " literal)))))

(define whitespace0
  (repeat0-parser whitespace-parser))

(define whitespace1
  (repeat1-parser whitespace-parser))

(define key-parser
  (repeat1-parser
   (choice-parser
    (list lowercase-parser
          (exact-char-parser #\-)))))

(define unquoted-string-value-parser
  (repeat1-parser
   (choice-parser
    (list lowercase-parser
          uppercase-parser))))

(define number-value-parser
  (repeat1-parser digit-parser))

(define quoted-string-value-parser
  (map-parser

   (sandwich (exact-char-parser #\") ; Match opening quote
             (repeat0-parser
              (choice-parser
               (list lowercase-parser
                     uppercase-parser
                     (exact-char-parser #\space) ; Match space
                     (exact-char-parser #\,) ; Match comma
                     (exact-char-parser #\!)))) ; Match exclamation
             (exact-char-parser #\"
                                )) ; Match closing quote
    cadr)); Return the list of characters

;;; Value Parser
(define value-parser
  (choice-parser
   (list number-value-parser
         quoted-string-value-parser
         unquoted-string-value-parser)))



(define number-parser
  (repeat1-parser digit-parser))

(define number-as-integer-parser
  (map-parser number-parser
              (lambda (digits)
                (string->number (list->string digits)))))

(define key-parser-as-string
  (map-parser key-parser
              (lambda (chars)
                (list->string chars))))

(define value-parser-as-string
  (map-parser value-parser
              (lambda (result)
                (if (and (list? result) ; Check if it's a list
                         (and-map char? result)) ; Check if all elements are characters
                    (list->string result) ; Transform list of characters into a string
                    result)))) ; Leave numbers and other values as-is

(define key-value-parser-as-string
  (map-parser
   (concatenate-parser
    whitespace0
    key-parser-as-string ; Parse the key 
    whitespace0
    (exact-parser "=")
    whitespace0
    value-parser-as-string) ; Parse the value
   (lambda (result)
     (list (list-ref result 1) ; Extract the key 
           (list-ref result 5))))) ; Extract the value 

(define config-parser
  (repeat0-parser key-value-parser-as-string))

(define config-string "
name = Gareth
my-num = 123
rand-string = \"Hello, world!\"
")
(define parsed-config (config-parser config-string))

(display (car (unwrap parsed-config)))(newline)

It's output is: ((name Gareth) (my-num 123) (rand-string Hello, world!))