Named parameters, documented parameters, and named documented parameters in clojure

named_params.clj

(ns rbl.utils.named-params
  "Macros for creating functions with named and documented parameters.

The np-fn and defn-np macros are to create a functions with named parameters. They allow
for optional values to be provided in the fn declaration.  The key information (e.g. required
keys) will live on the metadata of the function.

The dp-fn and defn-dp macros are to create a functions with documented parameters. They
will not allow functions to be defined without providing a corresponding docstring for
each parameter.  The resulting para docs live as meta data on the fn.

The dnp-fn and defn-dnp are macros that create functions with named and documented parameters. "

  (:use [useful.map :only [map-keys]]
        [clojure.tools.macro :only [name-with-attributes]])
  (:require [clojure.set :as set]
            [clojure.string :as str]))

(defn- split
  "Splits a seq by the given predicate function. This is eager and will return a 2D vector.

Example:
 (split keyword? [:a 1 2 :b 3 :c 4 5]) => [[:a 1 2] [:b 3] [:c 4 5]]
"
  [pred coll]
  (reduce (fn [so-far e]
            (if (pred e)
              (conj so-far [e])
              (update-in so-far [(dec (count so-far))] conj e)))
          [] coll))

(defn- keys-error-message [extra-keys missing-keys]
  (let [set-message (fn [keys-set error-prefix]
                      (when-not (= keys-set #{})
                        (str error-prefix " keywords: " (str/join ", " keys-set))))]
    (str/join ", " (remove nil? [(set-message extra-keys "Extra")
                                 (set-message missing-keys "Missing")]))))

(defn- split-params [params]
  (split symbol? params))

(defn- actual-params [param-vecs]
  (mapv first param-vecs))

(defn extract-contracts-from-body [body]
  (let [first-form (first body)]
    (if (and (map? first-form)
             (or (:pre first-form) (:post first-form)))
      [first-form (rest body)]
      [{} body])))

(defmacro np-fn* [actual-params defaults body]
  (let [valid-keys (set (map keyword actual-params))
        defaulted-keys (->> defaults keys (map keyword) set)
        required-keys (set/difference valid-keys defaulted-keys)
        [contracts body] (extract-contracts-from-body body)]
    `(-> (fn [& {:keys ~actual-params :or ~defaults :as args-map#}]
           ~contracts
           (let [arg-keys# (-> args-map# keys set)
                 missing-keys# (set/difference ~required-keys arg-keys#)
                 extra-keys# (set/difference arg-keys# ~valid-keys)]
             (when-not (= #{} missing-keys# extra-keys#)
               (throw (IllegalArgumentException.
                       (str "Invalid named arguments. " (~keys-error-message extra-keys# missing-keys#))))))
           ~@body)
         (with-meta {:ks ~valid-keys :req-ks ~required-keys :opt-ks ~defaulted-keys}))))



(defmacro np-fn
  "Creates a function with named parameters and optional defaults.

Examples:
 (def foo (np-fn [a b 2 c 3]
            (+ a b c)))

 (foo :a 1) => 6
 (foo :a 1 :b 1) => 5
 (foo :a 1 :b 1 :foo 34) => throws error for extra key
 (foo :b 2 :c 2) => throws error for missing :a key "
  [params & body]
  (let [param-vecs (split-params params)
        defaults (into {} (filter #(= (count %) 2) param-vecs))]
    `(np-fn* ~(actual-params param-vecs) ~defaults ~body)))

(defn- ensure-param-doc-strings [param-vecs]
  (when-not (every? (fn [t] (string? (get t 1))) param-vecs)
    (throw (IllegalArgumentException. "Each parameter declaration requires a corresponding docstring."))))

(defn- extract-param-docs [param-vecs]
  (ensure-param-doc-strings param-vecs)
  (map-keys (into {} (map #(vec (take 2 %)) param-vecs)) keyword))

(defmacro dp-fn
  "Creates a function with documented parameters. The param docstrings will be attached as
   metadata to the function.

Examples:
 (def foo (dp-fn [a \"this is a ...\"
                  b \"this is a ...\"
                  c \"this is a ...\"]
            (+ a b c)))

 (def bar (dp-fn [x] x)) => Thorws an error since no docstring was provided for parameter x."
  [params-with-docs & body]
  (let [param-vecs (split-params params-with-docs)
        param-docs (extract-param-docs param-vecs)]
    (when (odd? (count params-with-docs))
      (throw (IllegalArgumentException.
              "Odd number of params with docstrings! You must provide a single String for every param. Did you mean to use dnp-fn?")))
    `(vary-meta
       (fn ~(actual-params param-vecs)
         ~@body)
       assoc :param-docs ~param-docs)))

(defmacro dnp-fn
  "Creates a function with documented named parameters and optional defaults.

Examples:
 (def foo (dnp-fn [a \"doc for a\"
                   b \"doc for b\" 2
                   c \"doc for c\" 3]
            (+ a b c)))

 (foo :a 1) => 6
 (foo :a 1 :b 1) => 5
 (foo :a 1 :b 1 :foo 34) => throws error for extra key
 (foo :b 2 :c 2) => throws error for missing :a key

 (def bar (dnp-fn [x] x)) => Thorws an error since no docstring was provided for parameter x.
"
  [params & body]
  (let [param-vecs (split-params params)
        param-docs (extract-param-docs param-vecs)
        defaults (->> param-vecs
                      (filter #(= (count %) 3))
                      (map (fn [[param _doc default]] [param default]))
                      (into {}))]
    `(vary-meta
      (np-fn* ~(actual-params param-vecs) ~defaults ~body)
      assoc :param-docs ~param-docs)))


;; TODO: dry these up... template macros?
(defmacro defn-np
  {:arglists '[[name doc-string? attr-map? [params*] prepost-map? body]]
   :indent 'defun
   :doc (-> #'np-fn meta :doc)}
  [fn-name & body]
  (let [[fn-name [args & body]] (name-with-attributes fn-name body)
        param-vecs (split-params args)
        fn-meta (merge (meta fn-name) {:arglists (list 'quote [args])})]
    `(do
       (def ~(with-meta fn-name fn-meta)
         (np-fn ~args ~@body)))))

(defmacro defn-dp
  {:arglists '[[name doc-string? attr-map? [params*] prepost-map? body]]
   :indent 'defun
   :doc (-> #'dnp-fn meta :doc)}
  [fn-name & body]
  (let [[fn-name [args & body]] (name-with-attributes fn-name body)
        param-vecs (split-params args)
        fn-meta (merge (meta fn-name)
                       {:param-docs (extract-param-docs param-vecs)
                        :arglists (list 'quote [args])})]
    `(do
       (def ~(with-meta fn-name fn-meta)
         (dp-fn ~args ~@body)))))

(defmacro defn-dnp
  {:arglists '[[name doc-string? attr-map? [params*] prepost-map? body]]
   :indent 'defun
   :doc (-> #'dnp-fn meta :doc)}
  [fn-name & body]
  (let [[fn-name [args & body]] (name-with-attributes fn-name body)
        param-vecs (split-params args)
        fn-meta (merge (meta fn-name)
                       {:param-docs (extract-param-docs param-vecs)
                        :arglists (list 'quote [args])})]
    `(do
       (def ~(with-meta fn-name fn-meta)
         (dnp-fn ~args ~@body)))))

named_params_test.clj

(ns rbl.utils.named-params-test
  (:use midje.sweet
        rbl.utils.named-params))

(facts "#'np-fn"
  (facts "with fns defined with no defaults"
    (let [fn-with-no-defaults (np-fn [a b c] {:a a :b b :c c})]
      (fn-with-no-defaults :a 1 :b 2 :c 3) => {:a 1 :b 2 :c 3}
      (fn-with-no-defaults :b 2 :c 3 :a 1) => {:a 1 :b 2 :c 3}
      (fn-with-no-defaults :c 3) => (throws IllegalArgumentException "Invalid named arguments. Missing keywords: :a, :b")
      (fn-with-no-defaults :a 1 :b 2 :c 3 :d 4) => (throws IllegalArgumentException "Invalid named arguments. Extra keywords: :d")
      (fn-with-no-defaults :a 1 :b 2 :d 4) => (throws IllegalArgumentException "Invalid named arguments. Extra keywords: :d, Missing keywords: :c")))

  (facts "allows for :pre and :post contracts"
    (let [fn-with-contracts (np-fn [a b c]
                                   {:pre [(number? a)]}
                                   (+ a b c))]
      (fn-with-contracts :a "a" :b 2 :c 3) => (throws AssertionError)))

  (facts "with fns defined with some defaults"
    (let [fn-with-some-defaults (np-fn [a b 2 c 3] {:a a :b b :c c})]
      (fn-with-some-defaults :a 1) => {:a 1 :b 2 :c 3}
      (fn-with-some-defaults :a 1 :b 23 :c 32) => {:a 1 :b 23 :c 32}
      (fn-with-some-defaults :b 23 :c 32) => (throws IllegalArgumentException "Invalid named arguments. Missing keywords: :a")
      (fn-with-some-defaults :A 2 :b 23) => (throws IllegalArgumentException "Invalid named arguments. Extra keywords: :A, Missing keywords: :a")))

  (fact "attaches the key info as metadata (for later use in dep res. mostly)"
    (let [f (np-fn [a b 2 c 3] {:a a :b b :c c})]
      (meta f) => {:ks #{:a :b :c} :req-ks #{:a} :opt-ks #{:b :c}})))

(facts "#'dp-fn"
  (facts "when parameter docstrings are provided"
    (let [square
          (dp-fn [x "The Number that will be squared."]
                  (* x x))]
      (square 2) => 4 ;; it works!
      (-> square meta :param-docs) => {:x "The Number that will be squared."}))
  (facts "ensures every parameter has a docstring"
    (eval '(dp-fn [x] x)) => (throws IllegalArgumentException "Each parameter declaration requires a corresponding docstring."))
  (facts "ensures every parameter has only a docstring and not a default"
    (eval '(dp-fn [x "doc" 23] x)) => (throws IllegalArgumentException #"Odd number")))

(facts "#'dnp-fn"
  (facts "with fns defined with no defaults"
    (let [fn-with-no-defaults (dnp-fn [a "doc for a"
                                       b "for b"
                                       c "for c"]
                                 {:a a :b b :c c})]
      (fn-with-no-defaults :a 1 :b 2 :c 3) => {:a 1 :b 2 :c 3}
      (fn-with-no-defaults :b 2 :c 3 :a 1) => {:a 1 :b 2 :c 3}
      (fn-with-no-defaults :c 3) => (throws IllegalArgumentException)
      (fn-with-no-defaults :a 1 :b 2 :c 3 :d 4) => (throws IllegalArgumentException)
      (fn-with-no-defaults :a 1 :b 2 :d 4) => (throws IllegalArgumentException)))

  (facts "with fns defined with some defaults"
    (let [fn-with-some-defaults (dnp-fn [a "doc string for a"
                                         b "doc string for b" 2
                                         c "doc string for c" 3]
                                   {:a a :b b :c c})]
      (fn-with-some-defaults :a 1) => {:a 1 :b 2 :c 3}
      (fn-with-some-defaults :a 1 :b 23 :c 32) => {:a 1 :b 23 :c 32}
      (fn-with-some-defaults :b 23 :c 32) => (throws IllegalArgumentException)
      (fn-with-some-defaults :A 2 :b 23) => (throws IllegalArgumentException)))

  (facts "ensures every parameter has a docstring"
    (eval '(dnp-fn [x] x)) => (throws IllegalArgumentException #"requires"))

  (fact "attaches the param-docstring metadata"
    (let [square
          (dnp-fn [x "The Number that will be squared."]
                  (* x x))]
      (square :x 2) => 4 ;; it works!
      (-> square meta :param-docs) => {:x "The Number that will be squared."}
      (-> square meta :req-ks) => #{:x} ;; maintains the key metadata
      )))