aboutsummaryrefslogtreecommitdiff
;;; kolam --- GraphQL implementation
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of kolam.
;;;
;;; kolam is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU Affero General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; kolam is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with kolam.  If not, see
;;; <http://www.gnu.org/licenses/>.

(import (srfi srfi-64))

(define token-pattern
  (@@ (kolam parse) token-pattern))

(define token-value-pattern
  (@@ (kolam parse) token-value-pattern))

(define optional?
  (@@ (kolam parse) optional?))

(eval-when (expand load eval)
  (define (macro-ref module symbol)
    (macro-transformer
     (module-ref (resolve-module module) symbol))))

(define-syntax pattern-many
  (macro-ref '(kolam parse) 'pattern-many))

(define-syntax pattern-optional
  (macro-ref '(kolam parse) 'pattern-optional))

(define-syntax pattern-and
  (macro-ref '(kolam parse) 'pattern-and))

(define-syntax pattern-or
  (macro-ref '(kolam parse) 'pattern-or))

(test-begin "parse")

(test-assert "pattern-and should not fail when matching an optional pattern on an empty list of tokens"
  ((pattern-and identity
                (pattern-optional (token-pattern 'foo)))
   (list)))

(test-assert "pattern-or should not fail when matching an optional pattern on an empty list of tokens"
  ((pattern-or identity
               (pattern-optional (token-pattern 'foo)))
   (list)))

(test-equal "pattern-many should return an empty list when there are no matches"
  (list)
  ((pattern-many identity
                 (token-pattern 'foo))
   (list (cons 'bar 1))))

(test-end "parse")