Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Tree: 387acf6178
Fetching contributors…

Cannot retrieve contributors at this time

112 lines (90 sloc) 3.96 KB
;; cl-uri-templates
;; Extensive URI-Templates implementation in Common-Lisp.
;; Copyright 2009 Thomas de Grivel <>
;; Copyright (c) 2007, 2008, 2009 Vladimir Sedach
;; This software is provided "AS IS".
;; Please see COPYING for details.
(in-package #:cl-uri-templates)
(defvar *arity-p-of* (make-hash-table :test 'eq))
(defmacro lambda-list-arity-p (lambda-list)
with op = 'eql
with op-text = "equal to"
with count = 0
for token in lambda-list
until (when (eq token '&rest)
(setf op '>=
op-text "greater than"))
do (incf count)
finally (return `(list (function (lambda (n)
(,op n ,count)))
,(format nil "~A ~A" op-text count)))))
(defun check-op-arity (op arg-count)
(let ((found (gethash op *arity-p-of*)))
(when found
(destructuring-bind (arity-p text) found
(unless (funcall arity-p arg-count)
(error 'invalid-op-vars-error
:message (format nil
"Invalid variable count. The number of ~
variables for operator ~A must be ~A."
op text)))))))
(defmacro define-operator (name (arg &rest arguments) &body body)
(setf (gethash ',name *arity-p-of*)
(lambda-list-arity-p ,arguments))
(defmacro ,name ,(cons arg arguments)
(define-operator cl-uri-templates.operators:-opt (argument variable)
`(if ,variable
(define-operator cl-uri-templates.operators:-neg (argument variable)
`(if ,variable
(define-operator cl-uri-templates.operators:-prefix (argument variable)
`(let ((var ,variable))
(if (consp var)
(apply #'concatenate 'string (loop
for v in var
collect ,argument
collect (princ-to-string (or v ""))))
(concatenate 'string ,argument (princ-to-string (or var ""))))))
(define-operator cl-uri-templates.operators:-suffix (argument variable)
`(let ((var ,variable))
(if (consp var)
(apply #'concatenate 'string (loop
for v in ,variable
collect (princ-to-string (or v ""))
collect ,argument))
(concatenate 'string (princ-to-string (or var "")) ,argument))))
(define-operator cl-uri-templates.operators:-join (argument &rest variables)
((cl-uri-templates::uri-template-var (var &optional (default ""))
`(cons ,(string-downcase (symbol-name var))
(expand-uri-template-var ,var ,default))))
(apply #'concatenate 'string (loop
for var in (list ,@variables)
for sep = "" then ,argument
for (name . value) = var
collect sep
collect name
collect "="
collect (princ-to-string
(or value ""))))))
#+nil(-join "/"
(cl-uri-templates::uri-template-var a)
(cl-uri-templates::uri-template-var b))
(define-operator cl-uri-templates.operators:-list (argument variable)
`(let ((var ,variable))
(assert (typep var 'list)
() 'cl-uri-templates:invalid-op-vars-error
"Operator -list only accepts a variable containing a list.")
(apply #'concatenate 'string (loop
for v in var
for sep = "" then ,argument
collect sep
collect (princ-to-string (or v ""))))))
Jump to Line
Something went wrong with that request. Please try again.