utils: Type read-org-sexp and unorg.

This commit is contained in:
Sergiu Ivanov 2022-01-23 15:57:50 +01:00
parent ec84924608
commit 69a7234665
2 changed files with 29 additions and 5 deletions

View file

@ -177,6 +177,17 @@ violation for func will be generated.
(map-sexp (λ (x) (add1 (cast x Number))) '(1 2 (4 10) 3)) (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{Additional graph utilities}
@section{Pretty printing} @section{Pretty printing}

View file

@ -16,7 +16,7 @@
(provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/: (provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
extract-symbols any->string stringify-variable-mapping string->any 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 Variable Symbol)
(define-type (VariableMapping A) (Immutable-HashTable Variable A)) (define-type (VariableMapping A) (Immutable-HashTable Variable A))
@ -183,20 +183,33 @@
(test-case "map-sexp" (test-case "map-sexp"
(check-equal? (map-sexp (λ (x) (add1 (cast x Number))) '(1 2 (4 10) 3)) (check-equal? (map-sexp (λ (x) (add1 (cast x Number))) '(1 2 (4 10) 3))
'(2 3 (5 11) 4)))) '(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) (require 'typed)
(provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/: (provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
extract-symbols any->string stringify-variable-mapping string->any extract-symbols any->string stringify-variable-mapping string->any
map-sexp) map-sexp read-org-sexp unorg)
;;; Untyped section. ;;; Untyped section.
(provide (provide
;; Functions ;; Functions
(contract-out [read-org-sexp (-> string? (listof any/c))] (contract-out [unstringify-pairs (-> (listof (general-pair/c string? any/c))
[unorg (-> string? (listof any/c))]
[unstringify-pairs (-> (listof (general-pair/c string? any/c))
(listof (general-pair/c symbol? any/c)))] (listof (general-pair/c symbol? any/c)))]
[read-org-variable-mapping (-> string? variable-mapping?)] [read-org-variable-mapping (-> string? variable-mapping?)]
[unorgv (-> string? variable-mapping?)] [unorgv (-> string? variable-mapping?)]