From 8b2bab4d9ef70a801bd46e8df17ba7d96fd2fd74 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Thu, 27 Jan 2022 21:10:13 +0100
Subject: [PATCH] utils: Type read-org-variable-mapping and unorgv.

---
 scribblings/utils.scrbl | 13 ++++++++++
 utils.rkt               | 56 ++++++++++++++++++++++-------------------
 2 files changed, 43 insertions(+), 26 deletions(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index 06a7c0f..93435e4 100644
--- a/scribblings/utils.scrbl
+++ b/scribblings/utils.scrbl
@@ -206,6 +206,19 @@ element with @racket[string->any] or keeps it as is if it is not a string.
 (unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))")))
 ]}
 
+@defproc*[([(read-org-variable-mapping [str String]) (VariableMapping Any)]
+           [(unorgv [str String]) (VariableMapping Any)])]{
+
+Reads a @racket[VariableMapping] from a string, such as the one which Org-mode
+produces from tables.
+
+@racket[unorgv] is a synonym of @racket[read-org-variable-mapping].
+
+@examples[#:eval utils-evaluator
+(read-org-variable-mapping
+  "((\"a\" . \"(and a b)\") (\"b\" . \"(or b (not a))\"))")
+]}
+
 @section{Additional graph utilities}
 
 @section{Pretty printing}
diff --git a/utils.rkt b/utils.rkt
index c373b6f..6812da0 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -11,7 +11,7 @@
 ;;; Typed section.
 
 (module typed typed/racket
-  (require typed/graph typed/rackunit
+  (require typed/graph typed/rackunit typed-compose
            (for-syntax syntax/parse racket/list))
 
   (provide
@@ -19,7 +19,8 @@
 
    eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
    extract-symbols any->string stringify-variable-mapping string->any
-   handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs)
+   handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
+   read-org-variable-mapping unorgv)
 
   (define-type Variable Symbol)
   (define-type (VariableMapping A) (Immutable-HashTable Variable A))
@@ -224,20 +225,43 @@
                     '((a . 1) (b . (and a (not b)))))
       (check-equal? (unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))")))
                     '((a . 1) (b . (and a (not b)))))))
+
+  (: read-org-variable-mapping (-> String (VariableMapping Any)))
+  (define read-org-variable-mapping
+    (multi-compose
+     (λ ([pairs : (Listof (Pair Symbol Any))])
+       (make-immutable-hash pairs))
+     (λ (sexp)
+       (unstringify-pairs (cast sexp (Listof (GeneralPair String Any)))))
+     string->any))
+
+  ;;; A synonym for read-org-variable-mapping.
+  (define unorgv read-org-variable-mapping)
+
+  (module+ test
+    (test-case "read-org-variable-mapping"
+      (define m1 (read-org-variable-mapping "((\"a\" \"(and a b)\") (\"b\" \"(or b (not a))\"))"))
+      (define m2 (read-org-variable-mapping "((\"a\" . \"(and a b)\") (\"b\" . \"(or b (not a))\"))"))
+      (define m3 (unorgv "((\"a\" . \"(and a b)\") (\"b\" . \"(or b (not a))\"))"))
+      (check-equal? (hash-ref m1 'a) '(and a b))
+      (check-equal? (hash-ref m2 'a) '(and a b))
+      (check-equal? (hash-ref m3 'a) '(and a b))
+      (check-equal? (hash-ref m1 'b) '(or b (not a)))
+      (check-equal? (hash-ref m2 'b) '(or b (not a)))
+      (check-equal? (hash-ref m3 'b) '(or b (not a)))))
   )
 
 (require 'typed)
 (provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
          extract-symbols any->string stringify-variable-mapping string->any
-         map-sexp read-org-sexp unorg unstringify-pairs)
+         map-sexp read-org-sexp unorg unstringify-pairs
+         read-org-variable-mapping unorgv)
 
 ;;; Untyped section.
 
 (provide
  ;; Functions
- (contract-out [read-org-variable-mapping (-> string? variable-mapping?)]
-               [unorgv (-> string? variable-mapping?)]
-               [dotit (-> graph? void?)]
+ (contract-out [dotit (-> graph? void?)]
                [read-symbol-list (-> string? (listof symbol?))]
                [drop-first-last (-> string? string?)]
                [list-sets->list-strings (-> (listof (set/c any/c)) (listof string?))]
@@ -303,26 +327,6 @@
   (or/c (list/c key-contract val-contract)
         (cons/c key-contract val-contract)))
 
-;;; Reads a variable mapping from a string, such as the one which
-;;; Org-mode produces from tables.
-(define read-org-variable-mapping
-  (compose make-immutable-hash unstringify-pairs string->any))
-
-(module+ test
-  (test-case "read-org-variable-mapping"
-    (define m1 (read-org-variable-mapping "((\"a\" \"(and a b)\") (\"b\" \"(or b (not a))\"))"))
-    (define m2 (read-org-variable-mapping "((\"a\" . \"(and a b)\") (\"b\" . \"(or b (not a))\"))"))
-    (define m3 (unorgv "((\"a\" . \"(and a b)\") (\"b\" . \"(or b (not a))\"))"))
-    (check-equal? (hash-ref m1 'a) '(and a b))
-    (check-equal? (hash-ref m2 'a) '(and a b))
-    (check-equal? (hash-ref m3 'a) '(and a b))
-    (check-equal? (hash-ref m1 'b) '(or b (not a)))
-    (check-equal? (hash-ref m2 'b) '(or b (not a)))
-    (check-equal? (hash-ref m3 'b) '(or b (not a)))))
-
-;;; A synonym for read-org-variable-mapping.
-(define unorgv read-org-variable-mapping)
-
 ;;; Typeset the graph via graphviz and display it.
 (define dotit (compose display graphviz))