refacotoring

.gitignore

@@ -4,4 +4,5 @@
 *.cmo
 _build/
 .DS_Store
+playground/
 

app/main.ml

@@ -1,32 +1,33 @@
 open Js_of_ocaml
+open Core
 
 module Utils = struct
   module U = Js_of_ocaml.Js.Unsafe
   module StringMap = Map.Make (String)
 
+  let execute_request (url : string) props =
+    let rec mk_req = function
+      | ReqObj props ->
+          U.obj (Array.of_list (List.map (fun (k, p) -> (k, mk_req p)) props))
+      | ReqValue v ->
+          U.inject v
+    in
+    U.global##fetch (U.inject url) (mk_req props)
+
   let entries_to_string_map entries =
     U.global ##. Array##from entries
     |> Js.to_array
     |> Array.fold_left
          (fun a e ->
            let k = e##at 0 in
-           let v = e##at 1 in
            if Js.typeof k = Js.string "string" then
-             StringMap.add (Js.to_string k) (Js.to_string v) a
+             StringMap.add (Js.to_string k) (Js.to_string (e##at 1)) a
            else a )
          StringMap.empty
 
   let make_response (body : string) =
     U.new_obj U.global ##. Response [|U.inject body|]
 
-  let post (url : string) (body : string) =
-    U.global##fetch (U.inject url)
-      (U.obj
-         [| ("method", U.inject "post")
-          ; ("body", U.inject body)
-          ; ("headers", U.obj [|("content-type", U.inject "application/json")|])
-         |] )
-
   let get_entries obj = U.global ##. Object##entries obj
 
   let log_error e = U.global##.console##error e
@@ -42,7 +43,7 @@ let fetch req env =
           ; body= Js.to_string body }
       with
       | Some cmd ->
-          let promise = Utils.post cmd.url cmd.body in
+          let promise = Utils.execute_request cmd.url cmd.props in
           (promise##catch (fun e -> Utils.log_error e))##then_ (fun _ ->
               Utils.make_response "" )
       | None ->

src/core.ml

@@ -14,7 +14,10 @@ type http_msg_props =
   {env: string StringMap.t; headers: string StringMap.t; body: string}
 [@@deriving show]
 
-type http_cmd_props = {url: string; body: string} [@@deriving show]
+type req_props = ReqValue of string | ReqObj of (string * req_props) list
+[@@deriving show]
+
+type http_cmd_props = {url: string; props: req_props} [@@deriving show]
 
 let handle' ({body; env; _} : http_msg_props) =
   match J.from_string body |> U.member "message" with
@@ -26,13 +29,21 @@ let handle' ({body; env; _} : http_msg_props) =
           Printf.sprintf "https://api.telegram.org/bot%s/deleteMessage"
             (StringMap.find "TG_TOKEN" env)
         in
+        let body =
+          `Assoc
+            [ ("chat_id", message |> U.member "chat" |> U.member "id")
+            ; ("message_id", message |> U.member "message_id") ]
+          |> Yojson.Safe.to_string
+        in
         Some
           { url
-          ; body=
-              `Assoc
-                [ ("chat_id", message |> U.member "chat" |> U.member "id")
-                ; ("message_id", message |> U.member "message_id") ]
-              |> Yojson.Safe.to_string }
+          ; props=
+              ReqObj
+                [ ("body", ReqValue body)
+                ; ("method", ReqValue "post")
+                ; ( "headers"
+                  , ReqObj [("content-type", ReqValue "application-json")] ) ]
+          }
       else None
 
 let handle'' ({env; headers; _} as msg) =

test/test.ml

@@ -15,29 +15,30 @@ let make_tests ?headers rules =
   in
   List.map
     (fun (expected, input) ->
-      let expected =
-        expected
-        |> Option.map (fun x ->
-               {url= "https://api.telegram.org/bot123/deleteMessage"; body= x} )
-      in
       test_case "test" `Quick (fun _ ->
-          let cmd_fmt =
-            Fmt.record
-              [ Fmt.field "url" (fun x -> x.url) Fmt.string
-              ; Fmt.field "body" (fun x -> x.body) Fmt.string ]
-          in
           check
-            (option (of_pp cmd_fmt))
+            (option (of_pp Fmt.string))
             "" expected
-            (Core.handle (make_msg input)) ) )
+            (Core.handle (make_msg input) |> Option.map show_http_cmd_props) )
+      )
     rules
 
 let samples =
   [ (None, {|{}|})
   ; ( None
     , {|{"update_id":569999999,"message":{"message_id":4699,"from":{"id":249999999,"is_bot":false,"first_name":"JohnDoe","username":"johndoe","language_code":"en"},"chat":{"id":249999999,"first_name":"JohnDoe","username":"johndoe","type":"private"},"date":1699999999,"text":"hello"}}|}
     )
-  ; ( Some {|{"chat_id":-1001000000000,"message_id":12000}|}
+  ; ( Some
+        {|{ Core.url = "https://api.telegram.org/bot123/deleteMessage";
+  props =
+  (Core.ReqObj
+     [("body",
+       (Core.ReqValue "{\"chat_id\":-1001000000000,\"message_id\":12000}"));
+       ("method", (Core.ReqValue "post"));
+       ("headers",
+        (Core.ReqObj [("content-type", (Core.ReqValue "application-json"))]))
+       ])
+  }|}
     , {|{"update_id":560000000,"message":{"message_id":12000,"from":{"id":240000000,"is_bot":false,"first_name":"Alex","username":"alex000","language_code":"en"},"chat":{"id":-1001000000000,"title":"GroupName","type":"supergroup"},"date":1600000000,"new_chat_participant":{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"},"new_chat_member":{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"},"new_chat_members":[{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"}]}}|}
     ) ]
   |> make_tests