nydp 0.5.1 → 0.6.0

data/lib/lisp/core-100-utils.nydp

@@ -1,13 +1,13 @@
 (chapter-start 'list-manipulation)
 
+;; alias for 'detect
+;; true if thing is in things, nil otherwise
 (def include? (thing things)
-  ; alias for 'detect
-  ; true if thing is in things, nil otherwise
   (detect thing things))
 
+;; sort 'things according to the value
+;; returned by 'f for each thing in 'things
 (def sort-by (f things)
-  ; sort 'things according to the value
-  ; returned by 'f for each thing in 'things
   (let tmp (hash)
     (each thing things
           (hash-cons tmp
@@ -17,7 +17,7 @@
            (map λx(hash-get tmp x)
                 (sort:hash-keys tmp)))))
 
-; like 'sort-by, except when 'f returns nil, use 'instead as the sort key instead
+;; like 'sort-by, except when 'f returns nil, use 'instead as the sort key instead
 (def safe-sort-by (f instead things)
   (sort-by λi(or (f i) instead) things))
 
@@ -27,38 +27,37 @@
 ;; takes a function f, returns a new function that takes a list and sorts the list by 'f
 (def safe-sort-by-f (f instead) (curry1 safe-sort-by f instead))
 
+;; basically (reduce freduce (map fmap things))
 (def mapreduce (fmap freduce things)
-  ; same as (reduce freduce (map fmap things))
-  ; returns the resulting list
-  (if (pair? things)
-      (freduce (fmap (car things))
-               (mapreduce fmap freduce (cdr things)))
-      things
-      (freduce (map fmap things))
-      (freduce)))
-
-; map 'f over 'things and sum the resulting list
-(def mapsum (f things) (mapreduce f + things))
-
+  (reduce freduce (map fmap things)))
+
+;; map 'f over 'things and sum the resulting list, excluding nils
+(def mapsum (f things)
+  (apply + 0 (compact:map f things)))
+
+;; returns a new function f which takes a parameter x
+;; for each call to f with any value Z for x
+;; f returns true if this f has previously seen Z
+;; f returns nil otherwise.
+;; Note that each call to 'seen? returns a new function with
+;; its own history independent of previous calls to 'seen?
 (def seen? ()
-  ; returns a new function f which takes a parameter x
-  ; for each call to f with any value Z for x
-  ; f returns true if this f has previously seen Z
-  ; f returns nil otherwise.
-  ; Note that each call to 'seen? returns a new function with
-  ; its own history independent of previous calls to 'seen?
   (let seen (hash)
     λx(returning seen.,x (= seen.,x t))))
 
 ; return a list containing all the elements of 'things, but with no duplicates
 (def uniqify (things) (reject (seen?) things))
 
+;; like 'group-by, but uses and returns the supplied 'h parameter which should be a hash instance
+(def group-by-h (f h things)
+  (returning h
+    (each thing things
+          (hash-cons h (f thing) thing))))
+
 ;; return a hash of 'things keyed by (f thing) for
 ;; each thing in 'things
 (def group-by (f things)
-  (returnlet hsh {}
-    (each thing things
-          (hash-cons hsh (f thing) thing))))
+  (group-by-h f {} things))
 
 (with (m2i λd(+ (* 12 d.year) (- d.month 1))
        i2m λi(date (/ i 12) (+ 1 (mod i 12)) 1))
@@ -70,22 +69,6 @@
         (let mi (m2i anchor)
           (map λm(i2m (+ mi m)) mm))))
 
-;; each call to the name 'accfn-name with an arg will append the arg to the end of a list.
-;; This form returns the resulting list.
-;; Example (collect first names from a list of people)
-;;
-;;   (accum a (each person people (a person.firstname)))
-;;
-;; will return (Alice Bob Carol Declan Eliza Fionn)
-;;
-(mac accum (accfn-name . body)
-  (w/uniq (things last-cons)
-    `(with (,last-cons (cons) ,things nil)
-       (= ,things ,last-cons)
-       (let ,accfn-name (fn (a) (= ,last-cons (cdr-set ,last-cons (cons a))) a)
-         ,@body
-         (cdr ,things)))))
-
 ;; like 'accum, except 'accfn-name expects 2 args, a key and a value
 ;; value is hash-consed onto key in an internally-maintained hash
 ;; the form returns the resulting hash
@@ -105,8 +88,10 @@
            (if (< n stop)
                (r (+ (acc n) 1))))))
 
-; return a function that returns 'start on first invocation,
-; and 'start + n * 'incr for each nth invocation
+;; return a function that returns 'start on first invocation,
+;; and 'start + n * 'incr for each nth invocation
+;;
+;; see also 'counter which does almost exactly the same thing
 (def seqf (start incr)
   (let i (or incr 1)
     (fn () (returning start (++ start i)))))
@@ -116,30 +101,30 @@
 ; for each item in 'args
 (def mapply (f args) (map λa(apply f a) args))
 
+;; create a function called 'name ; each invocation of the function will
+;; return the next value in 'things, cycling around to the start if no things are left
 (mac def/cycler (name things)
-  ; create a function called 'name ; each invocation of the function will
-  ; return the next value in 'things, cycling around to the start if no things are left
   `(with (i -1 xs ',things list-len ,(len things))
          (def ,name (j)
            (comment ,(just "each call to ~name returns the next value from ~(inspect things)"))
            (nth (= i (mod (+ 1 (or j i)) list-len))
                 xs))))
 
+;; returns a list (list a b c) where
+;; 'a is a subset of 'items
+;; 'b is the sum of sizes of items in 'a : (apply + (map size-f a))
+;; 'c is the subset of 'items not in 'a
+;; invariants:
+;; b < maximum-size
+;; 'a + 'c is equal to 'items
+;; arguments:
+;; 'items is the list of things of which you have too many
+;; 'bucket is either nil, or a list if you have an existing partially-filled bucket
+;; 'size-f is a function that can tell the size of each item in 'items
+;; 'bucket-size is the size of the existing bucket, or 0 if empty
+;; 'maximum-size is the maximum allowed size for the bucket
+;; implementation note: this function exploits the behaviour of '> returning its last argument when true
 (def bucket/fill (items bucket size-f bucket-size maximum-size)
-  ; returns a list (list a b c) where
-  ; 'a is a subset of 'items
-  ; 'b is the sum of sizes of items in 'a : (apply + (map size-f a))
-  ; 'c is the subset of 'items not in 'a
-  ; invariants:
-  ; b < maximum-size
-  ; 'a + 'c is equal to 'items
-  ; arguments:
-  ; 'items is the list of things of which you have too many
-  ; 'bucket is either nil, or a list if you have an existing partially-filled bucket
-  ; 'size-f is a function that can tell the size of each item in 'items
-  ; 'bucket-size is the size of the existing bucket, or 0 if empty
-  ; 'maximum-size is the maximum allowed size for the bucket
-  ; implementation note: this function exploits the behaviour of '> returning its last argument when true
   (aif (and items
             (> maximum-size (+ (size-f (car items)) bucket-size)))
        (bucket/fill (cdr items)
@@ -155,15 +140,15 @@
                     maximum-size)
        (list (rev bucket) bucket-size items)))
 
+;; used by 'fill-buckets
 (def bucket/new (buckets)
-  ; used by 'fill-buckets
   (cons { bucket-size 0 } buckets))
 
+;; useful for pagination where each item may have a different size
+;; returns a list of hash with keys 'bucket-size and key
+;; if buckets is non-nil, assumes it is a list of previously-established buckets
+;; will add new items to first bucket if its 'bucket-size permits
 (def fill-buckets (items max buckets size-f key)
-  ; useful for pagination where each item may have a different size
-  ; returns a list of hash with keys 'bucket-size and key
-  ; if buckets is non-nil, assumes it is a list of previously-established buckets
-  ; will add new items to first bucket if its 'bucket-size permits
   (if items
       (if buckets
           (let initial (car buckets)
@@ -177,7 +162,7 @@
           (fill-buckets items max (bucket/new buckets) size-f key))
       buckets))
 
-; return the list except for the last element
+;; return the list except for the last element
 (def all-but-last (things)
   (accum acc
          ((afn (xs)

data/lib/lisp/core-110-hash-utils.nydp

@@ -9,6 +9,11 @@
 (mac auto-hash names
   `(brace-list ,@(flatten:map λn(list n n) names)))
 
+;; allows #(a b c) as shortcut for (auto-hash a b c)
+;; which is itself a shortcut for { a a b b c c }
+(define-prefix-list-macro "#" no-vars keys
+  `(auto-hash ,@keys))
+
 ;; like 'map, but for a hash instead of a list ; provided function 'f takes three arguments,
 ;; a key, the corresponding value from the given hash, and the index of the item in the list
 (def map-hash (f h pre)
@@ -22,17 +27,26 @@
 ;; v, the value
 ;; i, the index
 ;;
-(def hash-transform-values (f h pre)
+(def hash-transform-values (f h)
   (returnlet newh {}
-    (map-hash λkvi(hash-set newh k (f k v i)))))
-
+    (map-hash λkvi(hash-set newh k (f k v i)) h)))
 
-;; Return a new hash where keys are (map f things) and values are the corresponding things.
-;; No attempt is made to avoid clobbering items. Use 'group-by if there are duplicate keys.
-(def hashify (f things)
+;; Return a new hash where keys are (map f things) and corresponding values are (map g things).
+;; No attempt is made to avoid clobbering items. Use 'group-by instead, if there are duplicate keys.
+;;
+;; example: (hashify &firstname x1 people) returns { "johann" <bach record> "ludwig" <beethoven record> }
+;;
+;; reverse: (hashify x1 &firstname people) returns { <bach record> "johann" <beethoven record> "ludwig" }
+;;
+;; example: (hashify &firstname &lastname people) returns { "johann" "bach" "ludwig" "van beethoven" }
+;;
+;; example: (hashify &born &lastname people) returns { 1685 "bach" 1770 "van beethoven" }
+;;
+;; reverse example: (hashify &lastname &born  people) returns { "bach" 1685 "van beethoven" 1770 }
+(def hashify (f g things)
   (returnlet hsh {}
              (each thing things
-                   (hash-set hsh (f thing) thing))))
+                   (hash-set hsh (f thing) (g thing)))))
 
 ;; like 'group-by, except 'f returns multiple items, each of which
 ;; is used to key the thing in question
@@ -59,3 +73,16 @@
        (each ,kvar (hash-keys ,xs)
          (let ,vvar (hash-get ,xs ,kvar)
            ,@body)))))
+
+;; merge two hashes of the format k => (v0 v1...)
+;;
+;; example: h0 is { a (1 2) b (3 4) }, h1 is { a (2 5) c (6 7) }
+;;
+;; (hash/merge-lists h0 h1) will be: { a (1 2 5) b (3 4) c (6 7) }
+;;
+;; Uses set-union when merging lists, so merged lists
+;; contain no duplicates.
+(def hash/merge-lists (h0 h1)
+  (returnlet h (hash-merge { } h0)
+    (each k (hash-keys h1)
+      (= h.,k (⋃ h.,k h1.,k)))))

data/lib/lisp/core-120-settings.nydp

@@ -3,7 +3,7 @@
 (assign settings {})
 (assign initial-settings {})
 
-; convert expr to a function that returns the expr, unless expr is a symbol in which case we assume it already refers to a fn
+;; convert expr to a function that returns the expr, unless expr is a symbol in which case we assume it already refers to a fn
 (def settings/fn (expr)
   (if (sym? expr)                 expr
       (or (atom? expr) (no expr)) `(k ,expr)
@@ -12,33 +12,38 @@
       (caris 'brace-list expr)    `(k ,expr)
                                   `(fn (_) ,expr)))
 
-; update value of setting 'name
+;; update value of setting 'name
 (mac set-setting (name value)
   `(do (hash-cons (dox-item-by-type 'setting ',(sym name))
                   'values
                   { plugin this-plugin script this-script value ',value })
        (hash-set settings ',(sym name) ,(settings/fn value))))
 
-; update value of setting 'name
+;; update value of setting 'name
 (mac reset-setting (name)
   `(set-setting ,name ,(hash-get initial-settings (sym name))))
 
+;; define a setting in the given 'context with a 'name and an 'initial value, with a 'doc to explain it
+;; if value is a function, it is invoked with 'context and 'name to retrieve its value
+;; if value is a constant, it is wrapped in a function to return the constant
 (mac def-setting (name initial)
-  ; define a setting in the given 'context with a 'name and an 'initial value, with a 'doc to explain it
-  ; if value is a function, it is invoked with 'context and 'name to retrieve its value
-  ; if value is a constant, it is wrapped in a function to return the constant
   (let context (car:string-split name ".")
     `(do (dox-add-doc ',(sym name)
                       'setting
                       ',(fetch-and-clear-comments)
                       nil
                       '(def-setting ,name ,initial)
-                      '(,(sym "settings/~context"))
-                      { setting { default ',initial context ',context name ',name } })
+                      (hash-merge
+                       { setting { default ',initial context ',context name ',name } }
+                       (dox/attrs (,(sym "settings/~context")))))
          (hash-set initial-settings ',(sym name) ',initial)
          (set-setting ,(sym name) ,initial))))
 
-; get the value of the given setting. Raises an error if the setting is unknown
+;; get the value of the given setting. Raises an error if the setting is unknown.
+;; (note for testing: when using set-settings in ruby, make sure to quote string values, eg
+;;  set-settings "key.for.setting" => "this is the value".inspect
+;;  or alternatively,
+;;  set-settings "key.for.setting" => '"this is the value"'
 (def setting (name)
   (aif (hash-get settings (sym name))
        (on-err (error "can't get value of setting ~name : stored object is ~(inspect it)")

data/lib/lisp/core-130-validations.nydp

@@ -8,11 +8,13 @@
   (def validate/fn+ (type context f)
     (hash-cons validations (list type context) f)))
 
-;;
 ;; returns a hash of error-name to list of error messages
 ;;
 ;; An empty return value signifies an error-free 'thing
 ;;
+;; @thing@ the thing to validate
+;; @context@ an identifier to select the subset of validations to apply
+;;
 (def validate (thing context)
   (returnlet msgs {}
     (let msgf λem(hash-cons msgs e m)
@@ -21,31 +23,44 @@
 
 ;; declare a validation routine for type 'type in context 'context
 ;;
-;; 'type must be a symbol
-;; 'context must be a symbol
-;; 'body is one or more nydp expressions.
+;; @type@ must be a symbol
+;; @context@ must be a symbol
+;; @body@ is one or more nydp expressions.
 ;;
-;; 'body will be embedded in a function with access to the following variables :
+;; @body@ will be embedded in a function with access to the following variables :
 ;;
 ;; * the value of the 'type argument
 ;; * ctx
 ;; * mf
 ;;
-;; 'mf ("message function") is a function that takes two arguments and is used to store
+;; @mf@ ("message function") is a function that takes two arguments and is used to store
 ;; the validation error message
 ;; example: (mf "Last name" "Last name must not be empty")
 ;;
 ;; example usage:
 ;;
-;; (validate/def invoice issue
-;;   (if (no invoice.account)
-;;       (mf "Account" "Account must be a client account"))
-;;   (if (!> invoice.total 0)
-;;       (mf "Amount"  "Amount must be greater than zero"))
-;;   (if (any? !&group invoice.invoice-items)
-;;       (mf "Group"   "Each line must be assigned to a group")))
+;; <pre><code>
+;;   (validate/def invoice issue
+;;     (if (no invoice.account)
+;;         (mf "Account" "Account must be a client account"))
+;;     (if (!> invoice.total 0)
+;;         (mf "Amount"  "Amount must be greater than zero"))
+;;     (if (any? !&group invoice.invoice-items)
+;;         (mf "Group"   "Each line must be assigned to a group")))
+;; </code></pre>
+;;
+;; <br>
 ;;
 ;; if your routine makes no call to 'mf then 'validate will return an empty hash, which should be
 ;; interpreted as signifying that the object in question is error free in the given context.
+;;
+;; run your validations thus:
+;;
+;; <pre><code>
+;;   (let validations (validate invoice 'issue)
+;;     (if (empty? validations)
+;;         (invoice.issue)))
+;; </code></pre>
+;;
 (mac validate/def (type context . body)
   `(validate/fn+ ',type ',context (fn (,type ctx mf) ,@body)))