From b56b6a3f88bdc5321a050dcc16f1760b0d13a21d Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sat, 12 Dec 2020 23:25:11 +0100
Subject: [PATCH] utils: Add read-org-variable-mapping and unorgv.

---
 scribblings/utils.scrbl | 16 ++++++++++++++++
 utils-untyped.rkt       |  4 +---
 utils.rkt               | 25 +++++++++++++++++++++++++
 3 files changed, 42 insertions(+), 3 deletions(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index 0c93812..a713a96 100644
--- a/scribblings/utils.scrbl
+++ b/scribblings/utils.scrbl
@@ -219,6 +219,22 @@ applied first.
 fancy-add1
 (fancy-add1 "1")
 ]}
+
+@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-untyped.rkt b/utils-untyped.rkt
index b46dec8..00b6581 100644
--- a/utils-untyped.rkt
+++ b/utils-untyped.rkt
@@ -10,9 +10,7 @@
 
 (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?))]
diff --git a/utils.rkt b/utils.rkt
index 2f7b6a1..0222f4a 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -7,6 +7,7 @@
          extract-symbols
          any->string stringify-variable-mapping string->any map-sexp
          read-org-sexp unorg unstringify-pairs compose-n compose-3 compose-4
+         read-org-variable-mapping unorgv
          ;; Syntax
          auto-hash-ref/explicit auto-hash-ref/:)
 
@@ -237,3 +238,27 @@
 (: compose-4 (All (a b c d e) (-> (-> d e) (-> c d) (-> b c) (-> a b) (-> a e))))
 (define (compose-4 f1 f2 f3 f4)
   (λ (x) (f1 (f2 (f3 (f4 x))))))
+
+(: read-org-variable-mapping (-> String (VariableMapping Any)))
+(define read-org-variable-mapping
+  (compose-3
+   (λ ([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)))))