scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

utils: Type read-org-variable-mapping and unorgv.

Browse source
This commit is contained in:
Sergiu Ivanov 2022-01-27 21:10:13 +01:00
parent 73afefdeb2
commit 8b2bab4d9e
2 changed files with 43 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
scribblings/utils.scrbl
View file

@ -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}

56
utils.rkt
View file

@ -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))