A JSON-RPC Scheme Stub for R3

prot-jsonrpc.r3

rebol [title: "JSON-RPC Scheme Stub" author: 'abolka date: 2013-03-17]

net-log: :print

sync-write: funct [port [port!] message] [
    port/awake: funct [event [event!]] [ ;; High-level protocol reactor
        net-log ['sync-event event/type]
        port: event/port
        subport: port/locals/subport
        switch event/type [
            connect [
                ;; @@ Better move the actual sending to the low-level reactor:
                ;; set up port/data here and signal 'write (or maybe even
                ;; 'wrote) to the subport.
                net-log ["->" trim/lines/tail to-string message]
                write subport message
            ]
            read [
                ;; @@ Handle a complete JSON-RPC response (in port/data) here.
            ]
            wrote [
                ;; @@ A single JSON-RPC request has been sent. Re-schedule
                ;; port for receveing the response.
                read subport
            ]
        ]
        false
    ]

    wait [port/locals/subport 5]
]

subawake: funct [event [event!]] [ ;; Low-level TCP reactor
    net-log ['subevent event/type]
    subport: event/port
    parent: subport/locals/parent
    switch event/type [
        lookup [
            open subport
        ]
        connect [
            wake-up parent make event! [type: 'connect port: parent]
        ]
        read [
            ;; @@ Continue reading until we have a full JSON response. Only
            ;; then invoke parent/awake 'read.
            net-log ["<-" trim/lines/tail to-string subport/data]
            parent/data: copy subport/data
            clear subport/data
            wake-up parent make event! [type: 'read port: parent]
            return true
        ]
        wrote [
            ;; @@ Continue writing until the full JSON request is sent. Only
            ;; then invoke parent/awake 'wrote.
            wake-up parent make event! [type: 'wrote port: parent]
        ]
        close [
            close subport
            return true
        ]
    ]
    false
]

sys/make-scheme [
    name: 'jsonrpc
    title: {Simple JSON-RPC demo scheme}
    spec: make system/standard/port-spec-net [port-id: 4321]

    actor: [
        open: funct [port [port!]] [
            subport: make port! make port/spec [scheme: 'tcp]
            subport/awake: :subawake
            subport/locals: context [
                parent: port
            ]
            open subport

            port/locals: context compose [
                subport: (subport)
            ]

            port
        ]

        open?: funct [port [port!]] [
            all [port/locals  open? port/locals/subport]
        ]

        close: funct [port [port!]] [
            close port/locals/subport
        ]

        write: funct [port [port!] message] [
            either open? port [
                ;; @@ Async mode: queue full message data in port locals,
                ;; then awake subport for writing, or write first chunk
                ;; of data to subport directly.
            ] [
                ;; @@ Sync mode: call sync wrapper.
                open port
                sync-write port message
                close port
            ]
        ]
    ]
]


;; vim: set syn=rebol: