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