misc-code/config-parser.lisp

;;;; config-parser.lisp

#+quicklisp (ql:quickload :parse-number)

(defpackage #:config-parser
  (:use :esrap
        :cl)
  (:import-from #:parse-number
                #:parse-number)
  (:export open-configuration-file
           get-config-drive))

(in-package #:config-parser)


;;; "config-parser" goes here. Hacks and glory await!

(defrule space
    (+ (or #\Space #\Tab #\Newline))
  (:constant nil))

(defrule identifier
    (* (or (alphanumericp character) "_" "-" "."))
  (:text t)
  (:lambda (identifier)
    (intern (string-upcase identifier) "KEYWORD")))

(defun not-doublequote (character)
  (not (eql #\" character)))

(defrule string-chars
    (or (not-doublequote character)
       (and #\\ #\")))

(defrule string
    (and #\" (* string-chars) #\")
  (:destructure (sq string eq)
                (declare (ignore sq eq))
                (text string)))

(defrule number
    (and (? (or "-" "+"))
       (+ (or "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
       (? (and "."
             (+ (or "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))))
       (? (and (or "e" "E")
             (? "-")
             (+ (or "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")))))
  (:text t)
  (:lambda (num-string)
    (parse-number num-string)))

(defrule block-title
    (and (? #\Newline) "[" (? space) identifier (? space) "]" (? #\Newline))
  (:destructure (nl1 lb sp1 ident sp2 rb nl)
                (declare (ignore nl1 lb sp1 sp2 rb nl))
                ident))

(defrule ident-path
    (and identifier (? space) "/" (? space) identifier)
  (:destructure (identa sp1 sep sp2 identb)
                (declare (ignore sp1 sep sp2))
                (list identa identb)))

(defrule variable-expression
    (and identifier (? space) "=" (? space) (or string number ident-path) (? #\Newline))
  (:destructure (identifier sp1 eq sp2 value nl)
                (declare (ignore sp1 eq sp2 nl))
                (cons identifier value)))

(defrule block-contents
    (* variable-expression)
  (:lambda (expressions)
    (loop for expression in expressions
       collect expression)))

(defrule block
    (and block-title block-contents)
  (:destructure (title contents)
                (cons title contents)))

(defrule file
    (* block)
  (:lambda (blocks)
    (loop for block in blocks
       collect block)))

(defun open-configuration-file (filename)
  (parse 'file
         (concatenate 'string
                      (with-open-file (input-file filename)
                        (loop for char = (read-char input-file nil 'foo)
                           until (eq char 'foo)
                           collect char)))))

(defun get-config-drive (section ident config)
  (cdr (assoc ident (cdr (assoc section config)))))