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]
    ]
]