Skip to content

Commit

Permalink
run formatter
Browse files Browse the repository at this point in the history
  • Loading branch information
mabiede committed Jan 23, 2025
1 parent e87f913 commit 1e69878
Show file tree
Hide file tree
Showing 43 changed files with 612 additions and 568 deletions.
1 change: 0 additions & 1 deletion .ocamlformat
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
version = 0.19.0
profile = janestreet
parse-docstrings = true
wrap-comments = true
20 changes: 10 additions & 10 deletions benchmark/src/httpaf.ml
Original file line number Diff line number Diff line change
Expand Up @@ -47,11 +47,11 @@ let benchmark =
let error_handler ?request:_ error start_response =
let response_body = start_response Headers.empty in
(match error with
| `Exn exn ->
Body.write_string response_body (Printexc.to_string exn);
Body.write_string response_body "\n"
| #Status.standard as error ->
Body.write_string response_body (Status.default_reason_phrase error));
| `Exn exn ->
Body.write_string response_body (Printexc.to_string exn);
Body.write_string response_body "\n"
| #Status.standard as error ->
Body.write_string response_body (Status.default_reason_phrase error));
Body.close_writer response_body
;;

Expand All @@ -61,11 +61,11 @@ let () =
let request_handler _ = benchmark in
let error_handler _ = error_handler in
Lwt.async (fun () ->
Lwt_io.establish_server_with_client_socket
~backlog:11_000
listen_address
(Server.create_connection_handler ~request_handler ~error_handler)
>>= fun _server -> Lwt.return_unit);
Lwt_io.establish_server_with_client_socket
~backlog:11_000
listen_address
(Server.create_connection_handler ~request_handler ~error_handler)
>>= fun _server -> Lwt.return_unit);
let forever, _ = Lwt.wait () in
Lwt_main.run forever
;;
140 changes: 70 additions & 70 deletions example/file_upload/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -32,76 +32,76 @@ let index_view ?(success = false) () =
layout
~title:"Opium file upload"
[ (if success
then
div
~a:[ a_class [ "mx-auto mt-16 max-w-lg rounded-md bg-green-50 p-4" ] ]
[ div
~a:[ a_class [ "flex" ] ]
[ div
~a:[ a_class [ "flex-shrink-0" ] ]
[ svg
~a:
[ Tyxml.Svg.a_class [ "h-5 w-5 text-green-400" ]
; Tyxml.Svg.a_viewBox (0., 0., 20., 20.)
; Tyxml.Svg.a_fill `CurrentColor
]
[ Tyxml.Svg.path
~a:
[ a_svg_custom "fill-rule" "evenodd"
; Tyxml.Svg.a_d
"M10 18a8 8 0 100-16 8 8 0 000 16zm3.707-9.293a1 1 0 \
00-1.414-1.414L9 10.586 7.707 9.293a1 1 0 00-1.414 \
1.414l2 2a1 1 0 001.414 0l4-4z"
; a_svg_custom "clip-rule" "evenodd"
]
[]
]
]
; div
~a:[ a_class [ "ml-3" ] ]
[ p
~a:[ a_class [ "text-sm leading-5 font-medium text-green-800" ] ]
[ txt "Successfully uploaded" ]
]
; div
~a:[ a_class [ "ml-auto pl-3" ] ]
[ div
~a:[ a_class [ "-mx-1.5 -my-1.5" ] ]
[ button
~a:
[ a_class
[ "inline-flex rounded-md p-1.5 text-green-500 \
hover:bg-green-100 focus:outline-none \
focus:bg-green-100 transition ease-in-out \
duration-150"
]
; a_aria "label" [ "Dismiss" ]
]
[ svg
~a:
[ Tyxml.Svg.a_class [ "h-5 w-5" ]
; Tyxml.Svg.a_viewBox (0., 0., 20., 20.)
; Tyxml.Svg.a_fill `CurrentColor
]
[ Tyxml.Svg.path
~a:
[ a_svg_custom "fill-rule" "evenodd"
; Tyxml.Svg.a_d
"M4.293 4.293a1 1 0 011.414 0L10 \
8.586l4.293-4.293a1 1 0 111.414 1.414L11.414 \
10l4.293 4.293a1 1 0 01-1.414 1.414L10 \
11.414l-4.293 4.293a1 1 0 01-1.414-1.414L8.586 \
10 4.293 5.707a1 1 0 010-1.414z"
; a_svg_custom "clip-rule" "evenodd"
]
[]
]
]
]
]
]
]
else div [])
then
div
~a:[ a_class [ "mx-auto mt-16 max-w-lg rounded-md bg-green-50 p-4" ] ]
[ div
~a:[ a_class [ "flex" ] ]
[ div
~a:[ a_class [ "flex-shrink-0" ] ]
[ svg
~a:
[ Tyxml.Svg.a_class [ "h-5 w-5 text-green-400" ]
; Tyxml.Svg.a_viewBox (0., 0., 20., 20.)
; Tyxml.Svg.a_fill `CurrentColor
]
[ Tyxml.Svg.path
~a:
[ a_svg_custom "fill-rule" "evenodd"
; Tyxml.Svg.a_d
"M10 18a8 8 0 100-16 8 8 0 000 16zm3.707-9.293a1 1 0 \
00-1.414-1.414L9 10.586 7.707 9.293a1 1 0 00-1.414 \
1.414l2 2a1 1 0 001.414 0l4-4z"
; a_svg_custom "clip-rule" "evenodd"
]
[]
]
]
; div
~a:[ a_class [ "ml-3" ] ]
[ p
~a:[ a_class [ "text-sm leading-5 font-medium text-green-800" ] ]
[ txt "Successfully uploaded" ]
]
; div
~a:[ a_class [ "ml-auto pl-3" ] ]
[ div
~a:[ a_class [ "-mx-1.5 -my-1.5" ] ]
[ button
~a:
[ a_class
[ "inline-flex rounded-md p-1.5 text-green-500 \
hover:bg-green-100 focus:outline-none \
focus:bg-green-100 transition ease-in-out \
duration-150"
]
; a_aria "label" [ "Dismiss" ]
]
[ svg
~a:
[ Tyxml.Svg.a_class [ "h-5 w-5" ]
; Tyxml.Svg.a_viewBox (0., 0., 20., 20.)
; Tyxml.Svg.a_fill `CurrentColor
]
[ Tyxml.Svg.path
~a:
[ a_svg_custom "fill-rule" "evenodd"
; Tyxml.Svg.a_d
"M4.293 4.293a1 1 0 011.414 0L10 \
8.586l4.293-4.293a1 1 0 111.414 1.414L11.414 \
10l4.293 4.293a1 1 0 01-1.414 1.414L10 \
11.414l-4.293 4.293a1 1 0 01-1.414-1.414L8.586 \
10 4.293 5.707a1 1 0 010-1.414z"
; a_svg_custom "clip-rule" "evenodd"
]
[]
]
]
]
]
]
]
else div [])
; form
~a:[ a_enctype "multipart/form-data"; a_action "/upload"; a_method `Post ]
[ div
Expand Down
8 changes: 4 additions & 4 deletions example/rock_server/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -59,10 +59,10 @@ let run () =
fd
in
Lwt.async (fun () ->
let* _ =
Lwt_io.establish_server_with_client_socket listen_address connection_handler
in
Lwt.return_unit);
let* _ =
Lwt_io.establish_server_with_client_socket listen_address connection_handler
in
Lwt.return_unit);
let forever, _ = Lwt.wait () in
Lwt_main.run forever
;;
Expand Down
35 changes: 18 additions & 17 deletions opium-graphql/src/opium_graphql.ml
Original file line number Diff line number Diff line change
Expand Up @@ -107,23 +107,24 @@ let execute_request schema ctx req =
| Ok (query, variables, operation_name) ->
let+ result = execute_query ctx schema variables operation_name query in
(match result with
| Ok (`Response data) -> data |> basic_to_safe |> Opium.Response.of_json ~status:`OK
| Ok (`Stream stream) ->
Graphql_lwt.Schema.Io.Stream.close stream;
let body = "Subscriptions are only supported via websocket transport" in
Opium.Response.of_plain_text ~status:`Bad_request body
| Error err -> err |> basic_to_safe |> Opium.Response.of_json ~status:`Bad_request)
| Ok (`Response data) -> data |> basic_to_safe |> Opium.Response.of_json ~status:`OK
| Ok (`Stream stream) ->
Graphql_lwt.Schema.Io.Stream.close stream;
let body = "Subscriptions are only supported via websocket transport" in
Opium.Response.of_plain_text ~status:`Bad_request body
| Error err -> err |> basic_to_safe |> Opium.Response.of_json ~status:`Bad_request)
;;

let make_handler
: type a.
make_context:(Rock.Request.t -> a) -> a Graphql_lwt.Schema.schema -> Rock.Handler.t
: type a.
make_context:(Rock.Request.t -> a) -> a Graphql_lwt.Schema.schema -> Rock.Handler.t
=
fun ~make_context schema req ->
fun ~make_context schema req ->
match req.Opium.Request.meth with
| `GET ->
if Httpaf.Headers.get req.Opium.Request.headers "Connection" = Some "Upgrade"
&& Httpaf.Headers.get req.Opium.Request.headers "Upgrade" = Some "websocket"
if
Httpaf.Headers.get req.Opium.Request.headers "Connection" = Some "Upgrade"
&& Httpaf.Headers.get req.Opium.Request.headers "Upgrade" = Some "websocket"
then
(* TODO: Add subscription support when there is a good solution for websockets with
Httpaf *)
Expand Down Expand Up @@ -155,12 +156,12 @@ let make_graphiql_handler ~graphql_endpoint req =
~etag:graphiql_etag
~mime_type:"text/html; charset=utf-8"
(fun () ->
match Asset.read "graphiql.html" with
| None -> Lwt.return_error `Internal_server_error
| Some body ->
let regexp = Str.regexp_string "%%GRAPHQL_API%%" in
let body = Str.global_replace regexp graphql_endpoint body in
Lwt.return_ok (Opium.Body.of_string body))
match Asset.read "graphiql.html" with
| None -> Lwt.return_error `Internal_server_error
| Some body ->
let regexp = Str.regexp_string "%%GRAPHQL_API%%" in
let body = Str.global_replace regexp graphql_endpoint body in
Lwt.return_ok (Opium.Body.of_string body))
in
if accept_html
then h req
Expand Down
37 changes: 18 additions & 19 deletions opium-graphql/test/request_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,9 @@ let schema =
"hello"
~typ:(non_null string)
~args:Arg.[ arg "name" ~typ:string ]
~resolve:
(fun _ () -> function
| None -> "world"
| Some name -> name)
~resolve:(fun _ () -> function
| None -> "world"
| Some name -> name)
])
;;

Expand Down Expand Up @@ -84,12 +83,12 @@ let suite =
Opium.Body.of_string
(Yojson.Safe.to_string
(`Assoc
[ ( "query"
, `String
"query A { hello(name: \"world\") } query B { hello(name: \
\"fail\") }" )
; "operationName", `String "A"
]))
[ ( "query"
, `String
"query A { hello(name: \"world\") } query B { hello(name: \
\"fail\") }" )
; "operationName", `String "A"
]))
in
test_case
~req:(Opium.Request.make ~headers:json_content_type ~body default_uri `POST)
Expand All @@ -101,11 +100,11 @@ let suite =
Opium.Body.of_string
(Yojson.Safe.to_string
(`Assoc
[ ( "query"
, `String
"query A { hello(name: \"world\") } query B { hello(name: \
\"fail\") }" )
]))
[ ( "query"
, `String
"query A { hello(name: \"world\") } query B { hello(name: \
\"fail\") }" )
]))
in
let query = Some [ "operationName", [ "A" ] ] in
let uri = Uri.with_uri ~query (Uri.of_string default_uri) in
Expand All @@ -124,9 +123,9 @@ let suite =
Opium.Body.of_string
(Yojson.Safe.to_string
(`Assoc
[ "query", `String "query A($name: String!) { hello(name: $name) }"
; "variables", `Assoc [ "name", `String "world" ]
]))
[ "query", `String "query A($name: String!) { hello(name: $name) }"
; "variables", `Assoc [ "name", `String "world" ]
]))
in
test_case
~req:(Opium.Request.make ~headers:json_content_type ~body default_uri `POST)
Expand All @@ -138,7 +137,7 @@ let suite =
Opium.Body.of_string
(Yojson.Safe.to_string
(`Assoc
[ "query", `String "query A($name: String!) { hello(name: $name) }" ]))
[ "query", `String "query A($name: String!) { hello(name: $name) }" ]))
in
let query =
Some [ "operationName", [ "A" ]; "variables", [ "{\"name\":\"world\"}" ] ]
Expand Down
42 changes: 21 additions & 21 deletions opium/src/app.ml
Original file line number Diff line number Diff line change
Expand Up @@ -189,10 +189,10 @@ let any methods route action t =
if List.length methods = 0
then
Logs.warn (fun f ->
f
"Warning: you're using [any] attempting to bind to '%s' but your list\n\
\ of http methods is empty route"
route);
f
"Warning: you're using [any] attempting to bind to '%s' but your list of http \
methods is empty route"
route);
let route = Route.of_string route in
methods
|> List.fold_left ~init:t ~f:(fun app meth -> app |> register ~meth ~route ~action)
Expand All @@ -214,11 +214,11 @@ let start app =
let middlewares = attach_middleware app in
setup_logger app;
Logs.info (fun f ->
f
"Starting Opium on %s:%d%s"
app.host
app.port
(if app.debug then " (debug mode)" else ""));
f
"Starting Opium on %s:%d%s"
app.host
app.port
(if app.debug then " (debug mode)" else ""));
run_unix
?backlog:app.backlog
~middlewares
Expand All @@ -234,12 +234,12 @@ let start_multicore app =
let middlewares = attach_middleware app in
setup_logger app;
Logs.info (fun f ->
f
"Starting Opium on %s:%d with %d cores%s"
app.host
app.port
app.jobs
(if app.debug then " (debug mode)" else ""));
f
"Starting Opium on %s:%d with %d cores%s"
app.host
app.port
app.jobs
(if app.debug then " (debug mode)" else ""));
run_unix_multicore
~middlewares
~host:app.host
Expand All @@ -263,12 +263,12 @@ let print_routes_f routes =
Printf.printf "%d Routes:\n" (Hashtbl.length routes_tbl);
Hashtbl.iter
(fun key data ->
Printf.printf
"> %s (%s)\n"
(Route.to_string key)
(data
|> List.map ~f:(fun m -> Httpaf.Method.to_string m |> String.uppercase_ascii)
|> String.concat ~sep:" "))
Printf.printf
"> %s (%s)\n"
(Route.to_string key)
(data
|> List.map ~f:(fun m -> Httpaf.Method.to_string m |> String.uppercase_ascii)
|> String.concat ~sep:" "))
routes_tbl
;;

Expand Down
Loading

0 comments on commit 1e69878

Please sign in to comment.