Merge pull request #10 from benknoble/module-langs-for-source-files

1. Create a set of unstable module langs (suffixed 2) that read trees as the
   main body of the module (some important modifiers are expected directly
   after the lang line, though arbitrary whitespace can separate them). This
   is a first draft to solve #4.

2. Standardize contributor syntax as in #5.

dia/antecedents.rkt

@@ -37,8 +37,8 @@ leaves have antecedents. But this has only been tested on antecedents trees.
   (#%module-begin
    (provide export)
    ;; unless path-strings quoted, #%datum unbound error (not sure why not automatically introduced)
-   (define tree (read-idea-attribution-tree 'ideas-p))
-   (define antes (read-idea-antecedents-tree 'antecedents-p))
+   (define tree (call-with-input-file 'ideas-p read-idea-attribution-tree))
+   (define antes (call-with-input-file 'antecedents-p read-idea-antecedents-tree))
    (unless (validate-appraisal tree)
      (error 'validate-appraisal "bad appraisal: ~a" tree))
    (define export (make-hash))

dia/antecedents2.rkt

@@ -0,0 +1,63 @@
+#lang racket
+
+(provide (rename-out [mb #%module-begin]) #%datum #%top #%top-interaction #%app)
+
+#| (Unstable) Module language for antecedents
+
+Format:
+  #lang abe/antecedents2 exported-antecedents-id [ideas-module imported-ideas-id]
+
+  - antecedents tree [antecedents]
+
+Meaning:
+
+- The body is an "antecedents" tree of roughly the same shape where the leaves
+have comma-separated antecedents in place of percentages.
+- Attribute antecedents by combining them with imported-ideas-id from
+ideas-module, which records the idea appraisals (see #lang abe/ideas2).
+- Export (provide) the exported-antecedents-id bound to the final attributions.
+
+|#
+
+(require syntax/parse/define
+         abe/dia)
+
+(define-syntax-parse-rule
+  (mb export:id {~datum <=} [ideas-mod:expr imported-ideas:id] {~datum <=} tree-data:expr)
+  (#%module-begin
+   (provide export)
+   (require (only-in ideas-mod imported-ideas))
+   (define antes 'tree-data)
+   (define export (make-hash))
+   (attribute-antecedents imported-ideas antes export)
+   (unless (validate-attributions export)
+     (error 'validate-attributions "bad attributions: ~a" export))))
+
+(module reader syntax/module-reader abe/antecedents2
+  #:whole-body-readers? #t
+  #:read reader
+  #:read-syntax syntax-reader
+
+  (require racket/match
+           syntax/strip-context
+           abe/tree-parser)
+
+  (define (syntax-reader src in)
+    (port-count-lines! in)
+    (define name (read-syntax src in))
+    (unless (symbol? (syntax-e name))
+      (raise (exn:fail:read
+              (format "expected identifier\n  read: ~s" name)
+              (current-continuation-marks)
+              (list (srcloc src (syntax-line name) (syntax-column name) (syntax-position name) (syntax-span name))))))
+    (define import (read-syntax src in))
+    (match (syntax->datum import)
+      [(list (not (? keyword?)) (? symbol?)) (void)]
+      [_ (raise (exn:fail:read
+                    (format "expected [module identifier]\n  read: ~s" import)
+                    (current-continuation-marks)
+                    (list (srcloc src (syntax-line name) (syntax-column name) (syntax-position name) (syntax-span name)))))])
+    (define tree (read-idea-antecedents-tree in))
+    (strip-context #`(#,name <= #,import <= #,tree)))
+  (define (reader in)
+    (syntax->datum (syntax-reader #f in))))

dia/attribution.rkt

@@ -40,7 +40,7 @@ larger than 2 are not yet supported.
   (#%module-begin
    (provide export)
    ;; unless path-strings quoted, #%datum unbound error (not sure why not automatically introduced)
-   (define tree (read-attribution-tree 'input))
+   (define tree (call-with-input-file 'input read-attribution-tree))
    (unless (validate-appraisal tree)
      (error 'validate-appraisal "bad appraisal: ~a" tree))
    (define export (make-hash))

dia/attribution2.rkt

@@ -0,0 +1,62 @@
+#lang racket
+
+(provide (rename-out [mb #%module-begin]) #%datum #%top #%top-interaction #%app)
+
+#| (Unstable) Module language for attributions
+
+Format:
+  #lang abe/attribution2 exported-attributions-id
+
+  - [contributors] Appraisal tree [N%]
+  ...
+
+Meaning:
+
+- The body is an "appraisal" tree. Roughly, markdown bulleted list in tree form,
+with bracketed percentags [N%] at the end of the line.
+- Validate appraisals.
+- Tally attributions.
+- Validate attributions.
+- Export (provide) the exported-attributions-id bound to the attributions.
+
+To identify attributions, contributors are listed, comma-separated, in
+[square-brackets] at the beginning of a bullet. This holds for labor, too, to
+name the project but permit additional description.
+
+|#
+
+(require syntax/parse/define
+         abe/dia)
+
+(define-syntax-parse-rule
+  (mb export:id {~datum <=} tree-data:expr)
+  (#%module-begin
+   (provide export)
+   (define tree 'tree-data)
+   (unless (validate-appraisal tree)
+     (error 'validate-appraisal "bad appraisal: ~a" tree))
+   (define export (make-hash))
+   (tally tree node-weight bump #:results export)
+   (unless (validate-attributions export)
+     (error 'validate-attributions "bad attributions: ~a" export))))
+
+(module reader syntax/module-reader abe/attribution2
+  #:whole-body-readers? #t
+  #:read reader
+  #:read-syntax syntax-reader
+
+  (require syntax/strip-context
+           abe/tree-parser)
+
+  (define (syntax-reader src in)
+    (port-count-lines! in)
+    (define name (read-syntax src in))
+    (unless (symbol? (syntax-e name))
+      (raise (exn:fail:read
+              (format "expected identifier\n  read: ~s" name)
+              (current-continuation-marks)
+              (list (srcloc src (syntax-line name) (syntax-column name) (syntax-position name) (syntax-span name))))))
+    (define tree (read-attribution-tree2 in))
+    (strip-context #`(#,name <= #,tree)))
+  (define (reader in)
+    (syntax->datum (syntax-reader #f in))))

dia/ideas2.rkt

@@ -0,0 +1,57 @@
+#lang racket
+
+(provide (rename-out [mb #%module-begin]) #%datum #%top #%top-interaction #%app)
+
+#| (Unstable) Module language for ideas
+
+Format:
+  #lang abe/ideas2 exported-ideas-id
+
+  - Ideas appraisal tree [N%]
+
+Meaning:
+
+- The body is an "appraisal" tree. Roughly, markdown bulleted list in tree
+form, with bracketed percentags [N%] at the end of the line.
+- Validate appraisals.
+- Tally idea attributions.
+- Validate attributions.
+- Export (provide) the exported-ideas-id bound to the attributions.
+
+|#
+
+(require syntax/parse/define
+         abe/dia)
+
+(define-syntax-parse-rule
+  (mb export:id {~datum <=} tree-data:expr)
+  (#%module-begin
+   (provide export)
+   (define tree 'tree-data)
+   (unless (validate-appraisal tree)
+     (error 'validate-appraisal "bad appraisal: ~a" tree))
+   (define export (make-hash))
+   (tally tree node-weight bump #:results export)
+   (unless (validate-attributions export)
+     (error 'validate-attributions "bad attributions: ~a" export))))
+
+(module reader syntax/module-reader abe/ideas2
+  #:whole-body-readers? #t
+  #:read reader
+  #:read-syntax syntax-reader
+
+  (require syntax/strip-context
+           abe/tree-parser)
+
+  (define (syntax-reader src in)
+    (port-count-lines! in)
+    (define name (read-syntax src in))
+    (unless (symbol? (syntax-e name))
+      (raise (exn:fail:read
+              (format "expected identifier\n  read: ~s" name)
+              (current-continuation-marks)
+              (list (srcloc src (syntax-line name) (syntax-column name) (syntax-position name) (syntax-span name))))))
+    (define tree (read-idea-attribution-tree in))
+    (strip-context #`(#,name <= #,tree)))
+  (define (reader in)
+    (syntax->datum (syntax-reader #f in))))

dia/tree-parser.rkt

@@ -1,6 +1,7 @@
 #lang racket
 
 (provide read-attribution-tree
+         read-attribution-tree2
          read-idea-attribution-tree
          read-idea-antecedents-tree)
 
@@ -19,18 +20,27 @@ corresponding kind of tree.
 
 ;; If this is not defined with function syntax, inner implementation functions
 ;; unbound because they are eagerly evaluated.
-(define-flow (read-attribution-tree f)
-  (~> file->lines
+(define-flow (read-attribution-tree ip)
+  (~> port->lines
+      (filter non-empty-string? _)
       (make-indent-based-tree (flow (regexp-replace* #px"[[:blank:]]" _ " ")))
       (tree-map label->attribution leaf->attribution)))
 
-(define-flow (read-idea-attribution-tree f)
-  (~> file->lines
+(define-flow (read-attribution-tree2 ip)
+  (~> port->lines
+      (filter non-empty-string? _)
+      (make-indent-based-tree (flow (regexp-replace* #px"[[:blank:]]" _ " ")))
+      (tree-map label->attribution leaf->attribution2)))
+
+(define-flow (read-idea-attribution-tree ip)
+  (~> port->lines
+      (filter non-empty-string? _)
       (make-indent-based-tree (flow (regexp-replace* #px"[[:blank:]]" _ " ")))
       (tree-map label->attribution label->attribution)))
 
-(define-flow (read-idea-antecedents-tree f)
-  (~> file->lines
+(define-flow (read-idea-antecedents-tree ip)
+  (~> port->lines
+      (filter non-empty-string? _)
       (make-indent-based-tree (flow (regexp-replace* #px"[[:blank:]]" _ " ")))
       (tree-map values leaf->antecedents)
       (leaves->hash car cdr)))
@@ -113,6 +123,19 @@ on format.
      (cons (if name2 (list name1 name2) name1)
            attribution)]))
 
+(define (leaf->attribution2 x)
+  (match x
+    ;; uniform contribution syntax (https://github.com/drym-org/dia/issues/5):
+    ;;     * [comma-separated contributors] contribution [allocation%]
+    ;; Arbitrary spaces are permitted between start of line and start of
+    ;; bulleted item.
+    [(regexp #px"^\\s*\\* \\[([^]]+)\\].*\\[([[:digit:].]+)%\\]"
+             (list _ contributors (app string->number attribution)))
+     (cons (~> (contributors)
+               (string-split ", ")
+               (if (~> cdr null?) car _))
+           attribution)]))
+
 (define (label->attribution x)
   (match x
     [(regexp #px"^\\s*\\* (.*) \\[([[:digit:].]+)%\\]"

tools/deanonymize.rkt

@@ -3,11 +3,11 @@
 
 #| Overview
 
-Assumes a very specific project structure. See adjance Makefile example for
+Assumes a very specific project structure. See adjacent Makefile example for
 details on "input" files and "output" files. Also assumes its placement in the
 project (next to the output files).
 
-*nix specifix: you'll need implementations of POSIX paste(1), column(1), and
+*nix specifics: you'll need implementations of POSIX paste(1), column(1), and
 POSIX sed(1). The column(1) implementation should support `-t` and `-s`.
 
 1. Build lookup tables from the anonymized and named files. Uses paste(1) to