added unstable/error, raise-misc-error
This commit is contained in:
Ryan Culpepper
parent
9bd5a9189b
commit
c7a6272f4b
113
collects/unstable/error.rkt
Normal file
113
collects/unstable/error.rkt
Normal file
|
|
@ -0,0 +1,113 @@
|
|||
#lang racket/base
|
||||
(require racket/contract/base)
|
||||
|
||||
#|
|
||||
TODO
|
||||
- more options
|
||||
- 'pretty : pretty-print, then use multi-line format as necessary
|
||||
- need no-contracts version?
|
||||
- document or remove #:details arg
|
||||
|#
|
||||
|
||||
;; A DetailsTable is (listof (cons Field any))
|
||||
;; A Field is one of
|
||||
;; - string
|
||||
;; - (cons string (listof FieldOption))
|
||||
;; A FieldOption is one of
|
||||
;; - 'multi
|
||||
;; - 'value
|
||||
;; - 'maybe
|
||||
|
||||
(define field-option/c (or/c 'multi 'value 'maybe))
|
||||
(define field/c (or/c string? (cons/c string? (listof field-option/c))))
|
||||
|
||||
(define details-list/c
|
||||
(recursive-contract
|
||||
(or/c '() (cons/c field/c (cons/c any/c details-list/c)))))
|
||||
|
||||
(provide/contract
|
||||
[raise-misc-error
|
||||
(->* (symbol? string?)
|
||||
(#:continued (or/c string? (listof string))
|
||||
#:constructor (-> string? continuation-mark-set? exn?))
|
||||
#:rest details-list/c
|
||||
any)]
|
||||
[compose-error-message
|
||||
(->* (symbol? string?)
|
||||
(#:continued (or/c string? (listof string)))
|
||||
#:rest details-list/c
|
||||
string?)])
|
||||
|
||||
;; ----
|
||||
|
||||
(define (raise-misc-error who message
|
||||
#:details [detail-table null]
|
||||
#:continued [continued-message null]
|
||||
#:constructor [constructor exn:fail]
|
||||
. field+detail-list)
|
||||
(raise
|
||||
(constructor
|
||||
(compose* who message
|
||||
continued-message
|
||||
(field+detail-list->table 'raise-misc-error field+detail-list detail-table))
|
||||
(current-continuation-marks))))
|
||||
|
||||
(define (compose-error-message who message
|
||||
#:details [detail-table null]
|
||||
#:continued [continued-message null]
|
||||
. field+detail-list)
|
||||
(let ([details
|
||||
(field+detail-list->table 'compose-error-message field+detail-list detail-table)])
|
||||
(compose* who message continued-message details)))
|
||||
|
||||
(define (compose* who message continued-message details)
|
||||
(let* ([parts (let loop ([details details])
|
||||
(cond [(null? details) null]
|
||||
[else
|
||||
(let* ([field+opts (car (car details))]
|
||||
[options (if (pair? field+opts) (cdr field+opts) '())]
|
||||
[value? (memq 'value options)]
|
||||
[multi? (memq 'multi options)]
|
||||
[maybe? (memq 'maybe options)]
|
||||
[convert-value
|
||||
(cond [value?
|
||||
(lambda (v) ((error-value->string-handler) v (error-print-width)))]
|
||||
[else
|
||||
(lambda (v) (format "~a" v))])]
|
||||
[field (if (pair? field+opts) (car field+opts) field+opts)]
|
||||
[value (cdr (car details))])
|
||||
(cond [(and (or maybe? multi? (not value?))
|
||||
(not value))
|
||||
(loop (cdr details))]
|
||||
[multi?
|
||||
(list* "\n " field ": "
|
||||
(let value-loop ([value value])
|
||||
(cond [(pair? value)
|
||||
(list* "\n "
|
||||
(convert-value (car value))
|
||||
(value-loop (cdr value)))]
|
||||
[(null? value)
|
||||
(loop (cdr details))])))]
|
||||
[else
|
||||
(list* "\n " field ": "
|
||||
(convert-value value)
|
||||
(loop (cdr details)))]))]))]
|
||||
[parts (let loop ([continued continued-message])
|
||||
(cond [(pair? continued) (list* "\n " (car continued) (loop (cdr continued)))]
|
||||
[(string? continued) (loop (list continued))]
|
||||
[(null? continued) parts]))]
|
||||
[parts (list* message (if (null? continued-message) "" ";") parts)]
|
||||
[parts (if who
|
||||
(list* (symbol->string who) ": " parts)
|
||||
parts)])
|
||||
(apply string-append parts)))
|
||||
|
||||
;; ----
|
||||
|
||||
(define (field+detail-list->table who lst onto)
|
||||
(cond [(null? lst) onto]
|
||||
[else
|
||||
(let ([field (car lst)]
|
||||
[value (cadr lst)])
|
||||
(cons (cons field value)
|
||||
(field+detail-list->table who (cddr lst) onto)))]))
|
||||
81
collects/unstable/scribblings/error.scrbl
Normal file
81
collects/unstable/scribblings/error.scrbl
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
#lang scribble/manual
|
||||
@(require scribble/eval "utils.rkt"
|
||||
(for-label racket/base racket/contract unstable/error))
|
||||
|
||||
@(define the-eval (make-base-eval))
|
||||
@(the-eval '(require unstable/error))
|
||||
|
||||
@title[#:tag "error"]{Errors}
|
||||
@unstable[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]]
|
||||
|
||||
@defmodule[unstable/error]
|
||||
|
||||
@defproc[(raise-misc-error [name symbol?]
|
||||
[message string?]
|
||||
[field (let ([option/c (or/c 'value 'multi 'maybe)])
|
||||
(or/c string? (cons/c string? (listof option/c))))]
|
||||
[value any/c] ... ...
|
||||
[#:continued continued-message (or/c string? (listof string?)) null]
|
||||
[#:constructor constructor
|
||||
(-> string? continuation-mark-set? exn?)
|
||||
exn:fail])
|
||||
any]{
|
||||
|
||||
Raises an exception with a message composed according to the Racket
|
||||
@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{error
|
||||
message convention}. The exception is created with
|
||||
@racket[constructor], which is @racket[exn:fail] by default.
|
||||
|
||||
The composed error message includes details consisting of the
|
||||
alternating @racket[field] and @racket[value] arguments. By default,
|
||||
@racket[value] is formatted as if by @racket[display] unless it is
|
||||
@racket[#f], in which case the detail line is omitted. The following
|
||||
options affect the formatting of the detail line:
|
||||
|
||||
@itemlist[
|
||||
|
||||
@item{@racket['multi] formats each element in the corresponding value,
|
||||
which must be a list, as a separate line}
|
||||
|
||||
@item{@racket['value] formats the value using
|
||||
@racket[error-value->string-handler]; the detail line is not omittable
|
||||
unless @racket['maybe] or @racket['multi] is also provided}
|
||||
|
||||
]
|
||||
|
||||
@examples[#:eval the-eval
|
||||
|
||||
(raise-misc-error 'mcbean "too many stars upon thars"
|
||||
'("given" value) 'star-bellied-sneetch
|
||||
'("stars" value) 3)
|
||||
|
||||
(raise-misc-error 'hal "unable to open pod bay doors"
|
||||
#:continued
|
||||
"this mission is too important to let you jeopardize it"
|
||||
"threat" "David Bowman"
|
||||
"detection" "lip reading")
|
||||
|
||||
(raise-misc-error 'car "missing car keys"
|
||||
'("searched" multi)
|
||||
(list "dresser" "desk" "kitchen table" "under sofa"
|
||||
"behind microwave" "in washing machine")
|
||||
"last seen"
|
||||
#f)
|
||||
]
|
||||
}
|
||||
|
||||
@defproc[(compose-error-message
|
||||
[name symbol?]
|
||||
[message string?]
|
||||
[field (let ([option/c (or/c 'value 'multi 'maybe)])
|
||||
(or/c string? (cons/c string? (listof option/c))))]
|
||||
[value any/c] ... ...
|
||||
[#:continued continued-message (or/c string? (listof string?)) null])
|
||||
string?]{
|
||||
|
||||
Like @racket[raise-misc-error], but produces a string conforming to
|
||||
the Racket @tech[#:doc '(lib
|
||||
"scribblings/reference/reference.scrbl")]{error message convention}.
|
||||
}
|
||||
|
||||
@(close-eval the-eval)
|
||||
|
|
@ -81,6 +81,7 @@ Keep documentation and tests up to date.
|
|||
@include-section["wrapc.scrbl"]
|
||||
@include-section["debug.scrbl"]
|
||||
@include-section["define.scrbl"]
|
||||
@include-section["error.scrbl"]
|
||||
@include-section["file.scrbl"]
|
||||
@include-section["find.scrbl"]
|
||||
@include-section["flonum.scrbl"]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user