#lang racket/base
(require
 racket/port
 racket/path
 racket/match
 racket/stream)

;; -----

(struct desc [name vals-alist]
  #:transparent)

(define (make-desc name syms strs)
  (desc name
        (sort (map cons syms strs)
              string<?
              #:key cdr)))

(define (read-desc port)
  (match (read port)
    [(? eof-object?) eof]
    [`[,(? symbol? name)
       (,(? symbol? syms)
        ,(? string? strs))
       ...]
     (make-desc name syms strs)]
    [s
     (error (format "invalid enum description: ~s" s))]))

(define (parser-file-name dsc)
  (format "~a.parser.inc" (desc-name dsc)))

(define (printer-file-name dsc)
  (format "~a.printer.inc" (desc-name dsc)))

(define (write-parser dsc [port (current-output-port)])
  (match-define (desc name vals) dsc)
  (for ([v+s (in-list vals)]
        [i (in-naturals)])
    (match-define (cons val str) v+s)
    (when (> i 0)
      (fprintf port "} else "))
    (fprintf port "if (strcmp(str, ~s) == 0) {\n  val = ~a;\n"
             str val))
  (unless (null? vals)
    (fprintf port "} else "))
  (fprintf port "{\n  return 1;\n}\n"))

(define (write-printer dsc [port (current-output-port)])
  (match-define (desc name vals) dsc)
  (fprintf port "switch (val) {\n")
  (for ([v+s (in-list vals)])
    (match-define (cons val str) v+s)
    (fprintf port "case ~a:\n  str = ~s;\n  break;\n" val str))
  (fprintf port "default:\n  IMPOSSIBLE(\"invalid enum value for `~a' printer\");\n}\n"
           name))

;; -----

(define (in-scan dir-path)
  (for*/stream ([file-path (in-directory dir-path)]
                #:when (equal? (path-get-extension file-path)
                               #".enums")
                [desc (in-port read-desc (open-input-file file-path))])
    desc))

(define (scan+gen scan-dir
                  build-dir)
  (for ([dsc (in-scan scan-dir)])
    (write-parser dsc
                  (open-output-file (build-path build-dir (parser-file-name dsc))
                                    #:exists 'replace))
    (write-printer dsc
                  (open-output-file (build-path build-dir (printer-file-name dsc))
                                    #:exists 'replace))))

;; -----

(module+ test
  (define (display-parser dsc)
    (for ([x (in-lines (open-input-string
                        (with-output-to-string
                          (λ () (write-parser dsc)))))])
      (printf "; ~a\n" x)))

  (display-parser (make-desc 'foobar
                             '(BAR FOO FAR BOO)
                             '("bar" "foo" "far" "boo")))

  (displayln (make-string 80 #\-))

  (display-parser (make-desc 'empty '() '())))

(module+ main
  (match (current-command-line-arguments)
    [(vector src build)
     (scan+gen src build)]))