utils: Type read-org-variable-mapping and unorgv.
This commit is contained in:
parent
73afefdeb2
commit
8b2bab4d9e
2 changed files with 43 additions and 26 deletions
|
@ -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))")))
|
(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{Additional graph utilities}
|
||||||
|
|
||||||
@section{Pretty printing}
|
@section{Pretty printing}
|
||||||
|
|
56
utils.rkt
56
utils.rkt
|
@ -11,7 +11,7 @@
|
||||||
;;; Typed section.
|
;;; Typed section.
|
||||||
|
|
||||||
(module typed typed/racket
|
(module typed typed/racket
|
||||||
(require typed/graph typed/rackunit
|
(require typed/graph typed/rackunit typed-compose
|
||||||
(for-syntax syntax/parse racket/list))
|
(for-syntax syntax/parse racket/list))
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
|
@ -19,7 +19,8 @@
|
||||||
|
|
||||||
eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
|
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 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 Variable Symbol)
|
||||||
(define-type (VariableMapping A) (Immutable-HashTable Variable A))
|
(define-type (VariableMapping A) (Immutable-HashTable Variable A))
|
||||||
|
@ -224,20 +225,43 @@
|
||||||
'((a . 1) (b . (and a (not b)))))
|
'((a . 1) (b . (and a (not b)))))
|
||||||
(check-equal? (unstringify-pairs '(("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)))))))
|
'((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)
|
(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 read-org-sexp unorg unstringify-pairs)
|
map-sexp read-org-sexp unorg unstringify-pairs
|
||||||
|
read-org-variable-mapping unorgv)
|
||||||
|
|
||||||
;;; Untyped section.
|
;;; Untyped section.
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
;; Functions
|
;; Functions
|
||||||
(contract-out [read-org-variable-mapping (-> string? variable-mapping?)]
|
(contract-out [dotit (-> graph? void?)]
|
||||||
[unorgv (-> string? variable-mapping?)]
|
|
||||||
[dotit (-> graph? void?)]
|
|
||||||
[read-symbol-list (-> string? (listof symbol?))]
|
[read-symbol-list (-> string? (listof symbol?))]
|
||||||
[drop-first-last (-> string? string?)]
|
[drop-first-last (-> string? string?)]
|
||||||
[list-sets->list-strings (-> (listof (set/c any/c)) (listof string?))]
|
[list-sets->list-strings (-> (listof (set/c any/c)) (listof string?))]
|
||||||
|
@ -303,26 +327,6 @@
|
||||||
(or/c (list/c key-contract val-contract)
|
(or/c (list/c key-contract val-contract)
|
||||||
(cons/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.
|
;;; Typeset the graph via graphviz and display it.
|
||||||
(define dotit (compose display graphviz))
|
(define dotit (compose display graphviz))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue