/topaz/types/error.topaz
Unknown | 174 lines | 168 code | 6 blank | 0 comment | 0 complexity | 1cfa2aa6efc2bb192051170377c7f33c MD5 | raw file
- Topaz [
- Title: "Topaz types: ERROR!"
- Author: "Gabriele Santilli"
- Copyright: 2011
- Type: Fake-Topaz
- ; License: {
- ; Permission is hereby granted, free of charge, to any person obtaining
- ; a copy of this software and associated documentation files
- ; (the "Software"), to deal in the Software without restriction, including
- ; without limitation the rights to use, copy, modify, merge, publish,
- ; distribute, sublicense, and/or sell copies of the Software, and to
- ; permit persons to whom the Software is furnished to do so, subject
- ; to the following conditions:
- ; The above copyright notice and this permission notice shall be included
- ; in all copies or substantial portions of the Software.
- ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
- ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
- ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
- ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
- ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
- ; OTHER DEALINGS IN THE SOFTWARE.
- ; }
- ]
- ; ===== TYPES: ERROR! =========================================================
- make-type 'error! [
- make: function [args] [res] [
- if not args [args: make-struct []]
- res: make-struct [
- type: error!
- category: any [args/category "Internal"]
- id: any [args/id "unspecified"]
- message: any [args/message "Unspecified error"]
- args: args/args
- stack: make block! none
- ]
- if args/stack [insert/only res/stack args/stack]
- res
- ]
- topaz-make: function [value] [blk] [
- switch-default value/type/name [
- "block!" [
- blk: make block! none
- append blk make none! none
- insert/only tail blk value
- topaz-make-error apply object!/topaz-make [blk]
- ]
- "object!" [
- topaz-make-error value
- ]
- "error!" [value]
- ] [
- apply error!/make [make-struct [
- category: "Script"
- id: "invalid-argument"
- message: "Invalid argument for MAKE ERROR!"
- args: value
- ]]
- ]
- ]
- mold: function [
- "Return a LOAD-able text representation of a value"
- err
- options:
- only: no [logic!] "Don't generate outer [ ] for block! values"
- flat: no [logic!] "Produce a single text line"
- limit [number! none!] "Don't return a string longer than LIMIT characters"
- indent: "" [string!] "Add this string after each new line (ignored if flat)"
- ] [result] [
- limit-string either flat [
- rejoin [
- "make error! [category: '" err/category " id: '" err/id " "
- "message: ^"" escape err/message "^" "
- either err/args [
- rejoin [
- "args: " mold/options [
- value: either word? err/args [make lit-word! err/args/word] [err/args]
- flat
- limit: limit
- ] " "
- ]
- ] [""]
- "stack: " mold/options [value: err/stack flat limit: limit] "]"
- ]
- ] [
- rejoin [
- "make error! [^/"
- indent " category: '" err/category "^/"
- indent " id: '" err/id "^/"
- indent " message: ^"" escape err/message "^"^/"
- either err/args [
- rejoin [
- indent " args: " mold/options [
- value: either word? err/args [make lit-word! err/args/word] [err/args]
- indent: indent + " "
- limit: limit
- ] "^/"
- ]
- ] [""]
- indent " stack: " mold/options [value: err/stack limit: limit indent: indent + " "] "^/"
- indent "]"
- ]
- ] limit
- ]
- do: function [err block] [] [
- reduce [err skip block 1]
- ]
- bind: :default-bind
- compile: function [err block] [] [
- reduce [ast-value err skip block 1]
- ]
- equal?: :default-equal?
- copy: function [value] [] [value]
- ]
- error!/("error!"): make-struct [
- equal?: function [err1 err2] [] [
- all [
- err1/category = err2/category
- err1/id = err2/id
- ]
- ]
- ]
- topaz-make-error: function [obj] [args err] [
- obj: obj/map
- args: make-struct []
- if obj/category [
- args/category: either obj/category/type/name = "word!" [obj/category/word] [none]
- ]
- if obj/id [
- args/id: either obj/id/type/name = "word!" [obj/id/word] [none]
- ]
- if obj/message [
- args/message: either obj/message/type/name = "string!" [obj/message/string] [none]
- ]
- if all [obj/args not none? obj/args] [
- args/args: obj/args
- ]
- err: apply error!/make [args]
- if all [obj/stack block? obj/stack] [
- err/stack: obj/stack
- ]
- err
- ]
- error: function [args] [] [
- throw apply error!/make [args]
- ]
- form-error: function [err] [res] [
- res: rejoin [
- "*** " err/category " error: " err/message
- either err/args [
- either all [err/category = "Internal" string? err/args] [
- ; JS error
- rejoin [": " err/args/string]
- ] [
- rejoin [": " mold/options [value: err/args flat limit: 80]]
- ]
- ] [""]
- ]
- foreach 'item err/stack/values [
- either all [err/category = "Internal" string? item] [
- ; JS error
- res: rejoin [res "^/*** JS Stack:^/" item/string "^/"]
- ] [
- res: rejoin [res "^/*** Stack: " mold/options [value: item only limit: 160 indent: " : "]]
- ]
- ]
- res
- ]