diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl index 036b6a2..9a20a59 100644 --- a/scribblings/utils.scrbl +++ b/scribblings/utils.scrbl @@ -177,6 +177,17 @@ violation for func will be generated. (map-sexp (λ (x) (add1 (cast x Number))) '(1 2 (4 10) 3)) ]} +@defproc*[([(read-org-sexp [str String]) Any] + [(unorg [str String]) Any])]{ + +Reads a @racket[sexp] from a string produced by Org-mode for a named table. + +@racket[unorg] is a shortcut for @racket[read-org-sexp]. + +@examples[#:eval utils-evaluator +(unorg "(#t \"#t\" \"#t \" '(1 2 \"#f\"))") +]} + @section{Additional graph utilities} @section{Pretty printing} diff --git a/utils.rkt b/utils.rkt index a4452b5..e9caa08 100644 --- a/utils.rkt +++ b/utils.rkt @@ -16,7 +16,7 @@ (provide 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) + handle-org-booleans map-sexp read-org-sexp unorg) (define-type Variable Symbol) (define-type (VariableMapping A) (Immutable-HashTable Variable A)) @@ -183,20 +183,33 @@ (test-case "map-sexp" (check-equal? (map-sexp (λ (x) (add1 (cast x Number))) '(1 2 (4 10) 3)) '(2 3 (5 11) 4)))) + + (: read-org-sexp (-> String Any)) + (define read-org-sexp + (compose ((curry map-sexp) (match-lambda + [(and (? string?) str) (string->any str)] + [x x])) + string->any)) + (define unorg read-org-sexp) + + (module+ test + (test-case "read-org-sexp" + (check-equal? (read-org-sexp "((\"a\" \"(and a b)\") (\"b\" \"(or b (not a))\"))") + '((a (and a b)) (b (or b (not a))))) + (check-equal? (unorg "(#t \"#t\" \"#t \" '(1 2 \"#f\"))") + '(#t #t #t '(1 2 #f))))) ) (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) + map-sexp read-org-sexp unorg) ;;; Untyped section. (provide ;; Functions - (contract-out [read-org-sexp (-> string? (listof any/c))] - [unorg (-> string? (listof any/c))] - [unstringify-pairs (-> (listof (general-pair/c string? any/c)) + (contract-out [unstringify-pairs (-> (listof (general-pair/c string? any/c)) (listof (general-pair/c symbol? any/c)))] [read-org-variable-mapping (-> string? variable-mapping?)] [unorgv (-> string? variable-mapping?)]