HTTPC in Red

httpc.red

#!/usr/local/bin/red

Red [
    Title: "HTTP Console"
    Date:  15-Dec-2018
    File: %httpc.red
    Version: 0.1.2
    Author: "Christopher Ross-Gill"
    History: [
        15-Dec-2018 0.1.2 "Red Version"
         8-Sep-2010 0.1.1 "Original Experiment"
    ]
]

httpc: make object! [
    command: request: response:
    root: path: query:
    commands: styles:
    emit: prompt: none

    root: any [
        all [
            url? system/script/args
            parse/all url ["http" opt "s" "://" to end]
            system/script/args
        ]
        http://www.red-lang.org
    ]
    path: ""

    styles: context [
        reset: "^[[0m"
        bold: context [on: "^[[1m" off: "^[[22m"]
        italic: context [on: "^[[3m" off: "^[[23m"]
        underline: context [on: "^[[4m" off: "^[[24m"]
        black: context [back: "^[[40m" text: "^[[30m"]
        red: context [back: "^[[41m" text: "^[[31m"]
        green: context [back: "^[[42m" text: "^[[32m"]
        yellow: context [back: "^[[43m" text: "^[[33m"]
        blue: context [back: "^[[44m" text: "^[[34m"]
        white: context [back: "^[[47m" text: "^[[37m"]
    ]

    if system/platform = 'Windows [ ; no colours for Windows
        foreach w words-of styles [set :w ""]
    ]

    emit: func [data [block! string!]][
        data: bind compose [(data)] styles
        print rejoin data
    ]

    fail: func [data [block! string!]][
        data: bind compose [red/back white/text " " (data) " " reset] styles
        print rejoin data
    ]

    prompt: func [data [block! string!]][
        data: bind compose [(data) " "] styles
        ask rejoin data
    ]

    request: make object! [
        action: headers: content: none
    ]

    send: func [spec [object!]][
        spec: write/info root/:path values-of spec
        spec: make object! [status: spec/1 headers: spec/2 content: spec/3]
        emit [
            case [
                spec/status < 299 [rejoin [green/back black/text]]
                spec/status < 399 [rejoin [blue/back white/text]]
                spec/status < 499 [rejoin [red/back white/text]]
                spec/status < 599 [rejoin [yellow/back black/text]]
            ]
            " " spec/status " " reset " " length? spec/headers " Headers"
        ]
        spec
    ]

    args: none

    commands: [
          "address " args: "http://" to end (root: to-url args)
        | "cd " opt "/" copy path to end ()
        | copy args ["get" | "post" | "head" | "put" | "delete"] end (
            request/action: to word! :args
            request/headers: []
            request/content: any [request/content ""]
            response: send request
        )
        | "body" end (
            case [
                not object? response [
                    fail "No Response Yet Received"
                ]

                /else [
                    emit [copy/part response/content 100 "..."]
                ]
            ]
        )
        | "type" end (
            case [
                not object? response [
                    fail "No Response Yet Received"
                ]

                not map? response/headers [
                    fail "No Headers Received"
                ]

                not find response/headers 'Content-Type [
                    fail "No Content-Type header"
                ]

                block? response/headers/content-type [
                    foreach header response/headers/Content-Type [
                        emit [green/text header reset]
                    ]
                ]
                string? response/headers/Content-Type [
                    emit [green/text response/headers/Content-Type reset]
                ]
            ]
        )
        | "content " args "[" (
            args: attempt [load/next args]
            request/content: try args/1
        )
        | to end (emit ["=== Unknown Command"])
    ]

    engage: does [
        while [not find ["q" "quit"] command: prompt [red/text root/:path reset ">"]][
            parse trim/head/tail command commands
            ()
        ]
    ]
]

usage.md