aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2024-11-25 00:20:05 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2024-11-25 00:20:05 -0300
commitf59749f0118807502618e25fba89c7a3fd083b54 (patch)
tree524bf89b394efe7fea4439a8f11b207364d1db25
parent3235bcba70e0b9a5e9a8ed0fc18f96ce5c6beb57 (diff)
downloadSakura-f59749f0118807502618e25fba89c7a3fd083b54.tar.gz
Sakura-f59749f0118807502618e25fba89c7a3fd083b54.zip
lwt socket server
-rw-r--r--bin/main.ml3
-rw-r--r--client.el24
-rw-r--r--flake.nix16
-rw-r--r--lib/dune2
-rw-r--r--lib/relation.ml14
5 files changed, 44 insertions, 15 deletions
diff --git a/bin/main.ml b/bin/main.ml
index 4ea66d0..40429e3 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,4 +1,5 @@
let () =
begin
- let _ = Relational_engine.Relation.write_and_retrieve() in ()
+ (* let _ = Relational_engine.Relation.write_and_retrieve() in () *)
+ Relational_engine.Server.start()
end
diff --git a/client.el b/client.el
new file mode 100644
index 0000000..91a85e6
--- /dev/null
+++ b/client.el
@@ -0,0 +1,24 @@
+(setq *mailbox* nil)
+
+(defun relational-engine-handler (process response)
+ ""
+ ;; (setq *mailbox* (json-read-from-string response))
+ (setq *mailbox* response)
+ (let ((response (process-get process :response)))
+ (message "Received: %s" response)
+ (delete-process process)))
+
+(setq relational-engine-address "localhost")
+(setq relational-engine-port 4457)
+
+(defun relational-client (content)
+ ""
+ (let ((connection (open-network-stream "relational-engine" "*relational-engine-socket*" relational-engine-address relational-engine-port)))
+ (process-put connection :response nil)
+ (set-process-filter connection 'relational-engine-handler)
+ (process-send-string connection content)))
+
+(setq msg "read")
+
+(relational-client msg)
+*mailbox*
diff --git a/flake.nix b/flake.nix
index 3f1e64f..da5d132 100644
--- a/flake.nix
+++ b/flake.nix
@@ -31,12 +31,6 @@
lib = legacyPackages.lib;
merklecpp = legacyPackages.callPackage ./deps/merklecpp.nix { };
libressl = legacyPackages.callPackage ./deps/libressl.nix { };
- ppx_xml_conv = ocamlPackages.janePackage {
- pname = "ppx_xml_conv";
- hash = "sha256-4U0ZlV8OYXwNUz3bbxf49qovGTI8vyn7L3YJy0AndrM=";
- meta.description = "Generate XML conversion functions from records";
- propagatedBuildInputs = [ ocamlPackages.ppxlib ocamlPackages.csvfields ocamlPackages.ppx_conv_func ];
- };
librelational_engine =
legacyPackages.callPackage ./deps/relational_engine_lib.nix {
libressl = libressl;
@@ -102,7 +96,8 @@
ppx_inline_test
ocamlPackages.ppx_deriving
ocamlPackages.ppx_sexp_conv
- ppx_xml_conv
+ ocamlPackages.lwt
+ ocamlPackages.lwt_log
];
strictDeps = true;
@@ -175,7 +170,8 @@
ocamlPackages.ppx_inline_test
ocamlPackages.ppx_deriving
ocamlPackages.ppx_sexp_conv
- ppx_xml_conv
+ ocamlPackages.lwt
+ ocamlPackages.lwt_log
];
} ''
echo "checking dune and ocaml formatting"
@@ -265,9 +261,11 @@
legacyPackages.cmake
legacyPackages.gcc
# legacyPackages.nixfmt-classic
- ppx_xml_conv
+ ocamlPackages.lwt
+ ocamlPackages.lwt_log
];
+
shellHook = ''
echo MERKLECPP_INCLUDE_PATH=$MERKLECPP_INCLUDE_PATH
echo LIBRESSL_INCLUDE_PATH=$LIBRESSL_INCLUDE_PATH
diff --git a/lib/dune b/lib/dune
index 8ad4a95..5b495a2 100644
--- a/lib/dune
+++ b/lib/dune
@@ -1,6 +1,6 @@
(library
(name relational_engine)
- (libraries ctypes ctypes-foreign data-encoding)
+ (libraries ctypes ctypes-foreign data-encoding lwt lwt.unix lwt_log)
(preprocess (pps ppx_deriving.show ppx_sexp_conv))
;; (c_library_flags -lssl -lcrypto -L %{env:LIBRESSL_LIB_PATH=})
;; (foreign_stubs
diff --git a/lib/relation.ml b/lib/relation.ml
index a4e14c4..1854875 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -1,9 +1,14 @@
open Sexplib0
open Sexplib0.Sexp_conv
-open Ppx_xml_conv
+
module Protocol = struct
- type tuples = string list list
- [@@deriving sexp, ]
+ type tuple = string list [@@deriving sexp]
+ type relation =
+ { attribute_name: string;
+ attribute_type: string;
+ tuples: tuple }
+ [@@deriving sexp]
+ type t = relation list [@@deriving sexp]
end
let write_and_retrieve() =
@@ -35,5 +40,6 @@ let write_and_retrieve() =
let+ (_, Command.Read last_name) = Command.commit_and_perform (List.tl stream) locations command_read2 in
(* List.iter (fun a -> print_endline a) (List.map Bytes.to_string first_name); *)
(* List.iter (fun a -> print_endline a) (List.map Bytes.to_string last_name); *)
- Ok (Sexp.to_string (Protocol.sexp_of_tuples [List.map Bytes.to_string first_name; List.map Bytes.to_string last_name]))
+ Ok (Sexp.to_string (Protocol.sexp_of_t [{attribute_name = "user/first-name"; attribute_type = "string"; tuples = List.map Bytes.to_string first_name};
+ {attribute_name = "user/last-name"; attribute_type = "string"; tuples = List.map Bytes.to_string last_name}]))
[@@warning "-8"] (* Suppress pattern match incomplete warnings *)