define-github-action.rkt

#lang racket

(provide github-action
         name
         on
         push
         branches
         pull_request
         jobs
         build
         runs-on
         steps
         uses
         run)

(require (for-syntax syntax/parse)
         syntax/extended)

(require yaml)

(define (github-action . e*)
  (write-yaml (apply hash-union e*)))

(define (name text)
  (hash "name" text))

(define (on . e*)
  (hash/merge "on" e*))

(define (push . e*)
  (hash/merge "push" e*))

(define (pull_request . e*)
  (hash/merge "pull_request" e*))

(define-syntax-rule (branches (e* ...))
  (hash "branches" (list e* ...)))

(define (jobs . e*)
  (hash/merge "jobs" e*))

(define (build . e*)
  (hash/merge "build" e*))

(define (runs-on text)
  (hash "runs-on" text))

(define (steps . e*)
  (hash "steps" e*))

(define-syntax (uses stx)
  (syntax-parse stx
    [(_ action:str
        (~optional (~seq #:name name))
        (~optional (~seq #:with with)))
     #'(hash "uses" action
             (~? (~@ "name" name))
             (~? (~@ "with" (expand-env with))))]))

(define-syntax (run stx)
  (syntax-parse stx
    [(_ (~optional (~seq #:name name))
        (~optional (~seq #:env env))
        str ...)
     #'(hash (~? (~@ "name" name))
             (~? (~@ "env" (expand-env env)))
             "run" (string-join (list str ...) "\n"))]))

(define-syntax (expand-env stx)
  (syntax-parse stx
    [(_ ([KEY* VAL*] ...))
     #'(hash (~@ (~str KEY*) VAL*) ...)]))

;; HELPERS

(require racket/hash)

(define (hash/merge key hash*)
  (hash key (apply hash-union hash*)))