REBOL [ Title: "Match" Author: "Christopher Ross-Gill" Date: 17-Sep-2013 Purpose: {Extract structured data from an unstructured block.} Version: 0.2.0 Home: http://www.ross-gill.com/page/Match Usage: [ result: match ["Product" $12.99][ name: string! ; requires a string value to be present, set to string value price: some money! ; requires one or more money values, set to block place: opt url! ; optional url value, set to url value or none ] ] ] wrap: func [body [block!]][ use collect [ parse body [ any [body: set-word! (keep to word! body/1) | skip] ] ] head body ] match: wrap [ interpolate: func [body [string!] escapes [any-block!] /local out][ body: out: copy body parse/all body [ any [ to #"%" body: ( body: change/part body reduce any [ select/case escapes body/2 body/2 ] 2 ) :body ] ] out ] filter: [ result: errors: #[none] messages: [ not-included "is not included in the list" excluded "is reserved" invalid "is missing or invalid" not-confirmed "doesn't match confirmation" not-accepted "must be accepted" empty "can't be empty" blank "can't be blank" too-long "is too long (maximum is %d characters)" too-short "is too short (minimum is %d characters)" wrong-length "is the wrong length (should be %d characters)" not-a-number "is not a number" too-many "has too many arguments" ] datatype: [ 'any-string! | 'binary! | 'block! | 'char! | 'date! | 'decimal! | 'email! | 'file! | 'get-word! | 'integer! | 'issue! | 'lit-path! | 'lit-word! | 'logic! | 'money! | 'none! | 'number! | 'pair! | 'paren! | 'path! | 'range! | 'refinement! | 'set-path! | 'set-word! | 'string! | 'tag! | 'time! | 'tuple! | 'url! | 'word! ] else: #[none] otherwise: [ ['else | 'or][ set else string! | copy else any [word! string!] ] | (else: #[none]) ] source: spec: rule: key: value: required: present: target: type: format: constraints: else: none constraint: use [is is-not? is-or-length-is op val val-type range group][ op: val: val-type: none is: ['is | 'are] is-or-length-is: [ [ ['length | 'size] (val: string-length? value val-type: integer!) | (val: :value val-type: :type) ] is ] is-not?: ['not (op: false) | (op: true)] [ is [ 'accepted otherwise ( unless true = value [report not-accepted] ) | 'confirmed opt 'by set val get-word! otherwise ( val: to-word val unless value = as/where :type get-from source :val format [ report not-confirmed ] ) | is-not? 'within set group any-block! otherwise ( either case [ block? value [value = intersect value group] true [found? find group value] ][ unless op [report excluded] ][ if op [report not-included] ] ) ] | is-or-length-is [ is-not? 'between [set range [range! | into [2 val-type]]] otherwise ( either op [ case [ val < target: range/1 [report too-short] val > target: range/2 [report too-long] ] ][ unless any [ val < range/1 val > range/2 ][report excluded] ] ) | 'more-than set target val-type otherwise ( unless val > target [report too-short] ) | 'less-than set target val-type otherwise ( unless val < target [report too-long] ) | set target val-type otherwise ( unless val = target [report wrong-length] ) ] ] ] do-constraints: does [constraints: [any constraint]] skip-constraints: does [constraints: [to set-word! | to end]] humanize: func [word][uppercase/part replace/all form word "-" " " 1] report: func ['message [word!]][ message: any [ all [string? else else] all [block? else select else message] reform [humanize key any [select messages message ""]] ] unless select errors :key [repend errors [:key copy []]] append select errors :key interpolate message [ #"w" [form key] #"W" [humanize key] #"d" [form target] #"t" [form type] ] ] engage: does [parse spec rule] ] make-filter: func [source spec rule][ spec: context compose/deep [ (filter) errors: copy [] result: copy [] rule: [(copy/deep rule)] spec: [(spec)] ] spec/source: copy source spec ] get-one: func [data type /local res][ parse data [some [res: type to end break | skip]] unless tail? res [take res] ] get-some: func [data type /local pos res][ res: make block! length? data parse data [some [pos: type (append/only res take pos) :pos | skip]] unless empty? res [res] ] match: func [ [catch] source [block!] spec [block!] /report-to errs [block!] ][ spec: make-filter source spec [ ( remove-each item result: copy spec [not set-word? item] result: context append result none ) some [ set key set-word! (key: to-word key) set required ['opt | 'any | 'some | none] copy type [lit-word! any ['| lit-word!] | datatype any ['| datatype]] otherwise ( switch/default required [ any [ value: get-some source type either value [do-constraints][skip-constraints] ] opt [ value: get-one source type either value [do-constraints][skip-constraints] ] some [ value: get-some source type either value [do-constraints][skip-constraints report invalid] ] ][ value: get-one source type either value [do-constraints][skip-constraints report invalid] ] result/(key): value ) constraints ] end (if all [not empty? source empty? errors][key: 'match report too-many]) ] unless spec/engage [raise "Could not parse Match specification"] all [block? errs insert clear errs spec/errors] if empty? spec/errors [spec/result] ] ]