gluon 0.18.2

A static, type inferred programming language for application embedding
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

let prelude = import! std.prelude
let io = import! std.effect.io
let { ? } = import! std.io
let string = import! std.string
let { (<>) } = import! std.prelude
let { map } = import! std.functor
let { (*>), wrap } = import! std.applicative
let { (<|>) } = import! std.alternative
let { flat_map, (>>=) } = import! std.monad
let { ? } = import! std.array
let { Result } = import! std.result
let { foldl } = import! std.foldable
let { Eff, ? } = import! std.effect
let { run_lift } = import! std.effect.lift

let http @ {
    Request, Response, HttpEffect, StatusCode,
    handle,
    empty_response,
    get,
    post,
    get_request,
    path,
    listen,
    read_chunk,
    write_response,
    fail,
    catch_error,

    status,
    method,
    uri,

    ?
} = import! std.http

let hello_world : Eff (HttpEffect r) Response =
    write_response (string.as_bytes "Hello World")
        *> (wrap { status = status.ok, .. http.response })

let echo_body request : Request -> Eff (HttpEffect r) () =
    do chunk = read_chunk request.body
    match chunk with
    | Some chunk -> write_response chunk *> echo_body request
    | None -> wrap ()

let echo : Eff (HttpEffect r) Response =
    (get_request >>= echo_body)
        *> wrap { status = status.ok, .. http.response }

let array_body request : Request -> Eff (HttpEffect r) (Array Byte) =
    do chunk = read_chunk request.body
    match chunk with
    | Some chunk ->
        do rest = array_body request
        wrap (chunk <> rest)
    | None -> wrap []

let sum : Eff (HttpEffect r) Response =
    let de @ { ? } = import! std.json.de
    do body = get_request >>= array_body
    match string.from_utf8 body with
    | Err _ ->
        seq write_response (string.as_bytes "Request contained invalid UTF-8")
        wrap { status = status.bad_request, .. http.response }
    | Ok string_body ->
        match de.deserialize string_body with
        | Ok int_array ->
            let int_array : Array Int = int_array
            let s = foldl (+) 0 int_array 
            seq write_response (string.as_bytes (show s))
            wrap { status = status.ok, .. http.response }
        | Err err ->
            seq write_response (string.as_bytes err)
            wrap { status = status.bad_request, .. http.response }


let handler : Eff (HttpEffect r) Response =
    (get *> path "/" *> hello_world)
        <|> (post *> path "/echo" *> echo)
        <|> (post *> path "/sum" *> sum)
        <|> (get *> path "/error" *> (wrap { status = status.internal_server_error, .. http.response }))

let print_error h = catch_error h (\msg -> io.println msg)

\port ->
    let action =
        seq io.println ("Opened server on port " <> show port)
        listen { port, .. http.default_listen_settings } handler
    run_lift action