server

5 files changed, 290 insertions, 18 deletions

diff --git a/bin/dune b/bin/dune
index f36ecf1..5a6c7d4 100644
--- a/bin/dune
+++ b/bin/dune
@@ -5,3 +5,9 @@
  (libraries relational_engine)
  (package sakura)
  (modes byte exe))
+
+(executable
+ (name server)
+ (modules server)
+ (libraries relational_engine unix)
+ (modes byte exe))
diff --git a/bin/server.ml b/bin/server.ml
new file mode 100644
index 0000000..a7b5fa3
--- /dev/null
+++ b/bin/server.ml
@@ -0,0 +1,254 @@
+open Relational_engine
+
+let default_port = 7777
+let default_limit = 50
+
+(* ============================================================================
+   Minimal JSON serialisation — no external deps
+   ============================================================================ *)
+
+let js_str s =
+  let buf = Buffer.create (String.length s + 2) in
+  Buffer.add_char buf '"';
+  String.iter (function
+    | '"'  -> Buffer.add_string buf {|\"|}
+    | '\\' -> Buffer.add_string buf {|\\|}
+    | '\n' -> Buffer.add_string buf {|\n|}
+    | '\r' -> Buffer.add_string buf {|\r|}
+    | '\t' -> Buffer.add_string buf {|\t|}
+    | c    -> Buffer.add_char buf c) s;
+  Buffer.add_char buf '"';
+  Buffer.contents buf
+
+let js_obj pairs =
+  "{" ^
+  String.concat ","
+    (List.map (fun (k, v) -> js_str k ^ ":" ^ v) pairs) ^
+  "}"
+
+let js_arr elems = "[" ^ String.concat "," elems ^ "]"
+let js_bool b    = if b then "true" else "false"
+let js_int  n    = string_of_int n
+
+(* ============================================================================
+   Value serialisation
+   ============================================================================ *)
+
+(** Convert an AbstractValue (Obj.t) to a JSON fragment.
+    Uses Obj tag inspection to recover Int / String / Float. *)
+let abstract_to_json (v : Conventions.AbstractValue.t) =
+  if Obj.is_int v then js_int (Obj.obj v : int)
+  else
+    let tag = Obj.tag v in
+    if tag = Obj.string_tag then js_str (Obj.obj v : string)
+    else if tag = Obj.double_tag then
+      let f = (Obj.obj v : float) in
+      if Float.is_nan f || Float.is_infinite f then "null"
+      else string_of_float f
+    else js_str "<opaque>"
+
+let tuple_to_json (t : Tuple.materialized) =
+  let pairs = Tuple.AttributeMap.bindings t.Tuple.attributes in
+  js_obj (List.map (fun (k, attr) -> (k, abstract_to_json attr.Attribute.value)) pairs)
+
+(* ============================================================================
+   Relation materialisation
+   ============================================================================ *)
+
+(** Iterate a generator up to [limit] tuples; returns (rows, truncated). *)
+let materialize_generator gen limit =
+  let rec go gen pos acc count =
+    if count >= limit then (List.rev acc, true)
+    else
+      match gen (Some pos) with
+      | Generator.Done       -> (List.rev acc, false)
+      | Generator.Error _    -> (List.rev acc, false)
+      | Generator.Value (t, next) ->
+        let mat = match t with
+          | Tuple.Materialized m -> Some m
+          | Tuple.NonMaterialized _ -> None
+        in
+        (match mat with
+         | None   -> go next (pos + 1) acc count
+         | Some m -> go next (pos + 1) (m :: acc) (count + 1))
+  in
+  go gen 0 [] 0
+
+(** Materialise either a stored or generator-backed relation. *)
+let materialize_relation storage (rel : Relation.t) limit =
+  let gen = Algebra.Memory.to_generator storage rel in
+  materialize_generator gen limit
+
+(* ============================================================================
+   JSON response builders
+   ============================================================================ *)
+
+let short_hash (h : string) = String.sub h 0 (min 8 (String.length h))
+
+let relation_to_json storage (db_hash : string) (rel : Relation.t) limit =
+  let schema_json =
+    js_arr (List.map (fun (a, d) ->
+      js_obj [("attr", js_str a); ("domain", js_str d)]
+    ) rel.Relation.schema)
+  in
+  let (tuples, truncated) = materialize_relation storage rel limit in
+  let rows_json = js_arr (List.map tuple_to_json tuples) in
+  js_obj [
+    ("type",      js_str "relation");
+    ("name",      js_str rel.Relation.name);
+    ("schema",    schema_json);
+    ("rows",      rows_json);
+    ("row_count", js_int (List.length tuples));
+    ("truncated", js_bool truncated);
+    ("db_hash",   js_str (short_hash db_hash));
+  ]
+
+let ok_response db_hash msg =
+  js_obj [
+    ("type",    js_str "ok");
+    ("message", js_str msg);
+    ("db_hash", js_str (short_hash db_hash));
+  ]
+
+let error_response db_hash msg =
+  js_obj [
+    ("type",    js_str "error");
+    ("message", js_str msg);
+    ("db_hash", js_str (short_hash db_hash));
+  ]
+
+(* ============================================================================
+   Error formatting
+   ============================================================================ *)
+
+let manip_err = function
+  | Manipulation.RelationNotFound s    -> "RelationNotFound: " ^ s
+  | Manipulation.RelationAlreadyExists s -> "RelationAlreadyExists: " ^ s
+  | Manipulation.TupleNotFound h       -> "TupleNotFound: " ^ h
+  | Manipulation.DuplicateTuple h      -> "DuplicateTuple: " ^ h
+  | Manipulation.ConstraintViolation s -> "ConstraintViolation: " ^ s
+  | Manipulation.StorageError s        -> "StorageError: " ^ s
+
+(* ============================================================================
+   Command execution
+   ============================================================================ *)
+
+let execute_command storage db_ref cmd =
+  let db = !db_ref in
+  let h  = db.Management.Database.hash in
+  (* 0. Special commands *)
+  let cmd = match String.trim cmd with
+    | "(schema)" -> {|(Base sakura:attribute)|}
+    | s -> s
+  in
+  (* 1. Try DRL *)
+  match Drl.Parser.of_string cmd with
+  | Ok query ->
+    (match Drl.Executor.Memory.execute storage db query with
+     | Ok rel -> relation_to_json storage h rel default_limit
+     | Error (Drl.Executor.Memory.RelationNotFound s) ->
+       error_response h ("RelationNotFound: " ^ s)
+     | Error (Drl.Executor.Memory.AlgebraError (Algebra.StorageError s)) ->
+       error_response h ("StorageError: " ^ s)
+     | Error (Drl.Executor.Memory.AlgebraError (Algebra.GeneratorError s)) ->
+       error_response h ("GeneratorError: " ^ s))
+  | Error _ ->
+    (* 2. Try DML *)
+    match Dml.Parser.of_string cmd with
+    | Ok stmt ->
+      (match Dml.Executor.Memory.execute storage db stmt with
+       | Ok new_db ->
+         db_ref := new_db;
+         ok_response new_db.Management.Database.hash "Database updated"
+       | Error (Dml.Executor.Memory.ManipulationError me) ->
+         error_response h (manip_err me)
+       | Error (Dml.Executor.Memory.RelationNotFound s) ->
+         error_response h ("RelationNotFound: " ^ s)
+       | Error (Dml.Executor.Memory.ParseError s) ->
+         error_response h ("ParseError: " ^ s))
+    | Error _ ->
+      (* 3. Try DCL *)
+      match Dcl.Parser.of_string cmd with
+      | Ok stmt ->
+        (match Dcl.Executor.Memory.execute storage db stmt with
+         | Ok new_db ->
+           db_ref := new_db;
+           ok_response new_db.Management.Database.hash "Constraint registered"
+         | Error (Dcl.Executor.Memory.ManipulationError me) ->
+           error_response h (manip_err me)
+         | Error (Dcl.Executor.Memory.ConversionError s) ->
+           error_response h ("ConversionError: " ^ s))
+      | Error _ ->
+        error_response h "Parse error: not valid DRL, DML, or DCL"
+
+(* ============================================================================
+   Prelude registration
+   ============================================================================ *)
+
+let register_prelude_relations storage db =
+  let open Prelude.Standard in
+  List.fold_left
+    (fun db (rel : Relation.t) ->
+      match Manipulation.Memory.create_immutable_relation storage db
+              ~name:rel.name
+              ~schema:rel.schema
+              ~generator:(Option.get rel.generator)
+              ~membership_criteria:rel.membership_criteria
+              ~cardinality:rel.cardinality
+      with
+      | Ok (new_db, _) -> new_db
+      | Error _        -> db)
+    db
+    [ less_than_natural
+    ; less_than_or_equal_natural
+    ; greater_than_natural
+    ; greater_than_or_equal_natural
+    ; equal_natural
+    ; not_equal_natural
+    ; plus_natural
+    ; times_natural
+    ; minus_natural
+    ; divide_natural
+    ]
+
+(* ============================================================================
+   TCP server
+   ============================================================================ *)
+
+let handle_client storage db_ref fd =
+  let ic = Unix.in_channel_of_descr fd in
+  let oc = Unix.out_channel_of_descr fd in
+  (try
+     while true do
+       let line = input_line ic in
+       let line = String.trim line in
+       if line <> "" then begin
+         let response = execute_command storage db_ref line in
+         output_string oc (response ^ "\n");
+         flush oc
+       end
+     done
+   with End_of_file | Unix.Unix_error _ -> ())
+
+let () =
+  let port = default_port in
+  match Management.Physical.Memory.create () with
+  | Error _ -> failwith "Failed to create storage"
+  | Ok storage ->
+    match Manipulation.Memory.create_database storage ~name:"sakura" with
+    | Error _ -> failwith "Failed to create initial database"
+    | Ok db ->
+      let db = register_prelude_relations storage db in
+      let db_ref = ref db in
+      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+      Unix.setsockopt sock Unix.SO_REUSEADDR true;
+      Unix.setsockopt sock Unix.SO_REUSEPORT true;
+      Unix.bind sock (Unix.ADDR_INET (Unix.inet_addr_loopback, port));
+      Unix.listen sock 5;
+      Printf.printf "Sakura server listening on 127.0.0.1:%d\n" port;
+      Printf.printf "Database hash: %s\n%!" (short_hash db.Management.Database.hash);
+      while true do
+        let (client_fd, _addr) = Unix.accept sock in
+        handle_client storage db_ref client_fd;
+        (try Unix.close client_fd with _ -> ())
+      done
diff --git a/lib/management/database.ml b/lib/management/database.ml
index e4705e5..08e03b8 100644
--- a/lib/management/database.ml
+++ b/lib/management/database.ml
@@ -72,7 +72,13 @@ let has_relation db name =
 
 (** Add a relation to the database *)
 let add_relation db ~(relation : Relation.t) =
-  let relation_hash = Option.get relation.hash in
+  let relation_hash = match relation.hash with
+    | Some h -> h
+    | None ->
+      let tree = Option.value relation.tree ~default:Merkle.empty in
+      Hashing.hash_relation ~name:relation.name ~schema:relation.schema ~tree
+  in
+  let relation = { relation with hash = Some relation_hash } in
   let tree = Merkle.insert relation_hash db.tree in
   let relations = RelationMap.add relation.name relation db.relations in
   update_state db ~relations ~tree
diff --git a/lib/manipulation.ml b/lib/manipulation.ml
index a1d90d6..5f7cfb9 100644
--- a/lib/manipulation.ml
+++ b/lib/manipulation.ml
@@ -770,9 +770,12 @@ module Make (Storage : Management.Physical.S) = struct
       match store_relation storage relation with
       | Error e -> Error e
       | Ok () ->
-        match store_database storage new_db with
+        match update_catalog_on_create storage new_db relation with
         | Error e -> Error e
-        | Ok () -> Ok (new_db, relation)
+        | Ok final_db ->
+          match store_database storage final_db with
+          | Error e -> Error e
+          | Ok () -> Ok (final_db, relation)
 
   (** Remove a relation from the database.
       Also removes its entries from [sakura:relation] and [sakura:attribute]. *)
diff --git a/lib/prelude/standard.ml b/lib/prelude/standard.ml
index aca7f93..efcb7ae 100644
--- a/lib/prelude/standard.ml
+++ b/lib/prelude/standard.ml
@@ -4,6 +4,9 @@
     with both attributes in the same domain. The domain's [compare] function
     is used for evaluation — no more spreading [Obj.magic]. *)
 
+(* Helper: wrap a native value in the Attribute.materialized record *)
+let mk v = { Attribute.value = Obj.repr v }
+
 (* ============================================================================
    Comparison relation factory
    ============================================================================ *)
@@ -66,7 +69,7 @@ let less_than_natural : Relation.t =
       let left, right = pair_of_nat_lt position in
       let attributes : Attribute.materialized Tuple.AttributeMap.t =
         Tuple.AttributeMap.of_list
-          [ ("left", Obj.magic left); ("right", Obj.magic right) ]
+          [ ("left", mk left); ("right", mk right) ]
       in
       Generator.Value
         ( Tuple.make_materialized ~relation:"less_than" ~attributes,
@@ -90,7 +93,7 @@ let less_than_or_equal_natural : Relation.t =
       let right = max a b in
       let attributes =
         Tuple.AttributeMap.of_list
-          [ ("left", Obj.magic left); ("right", Obj.magic right) ]
+          [ ("left", mk left); ("right", mk right) ]
       in
       Generator.Value
         ( Tuple.make_materialized ~relation:"less_than_or_equal" ~attributes,
@@ -110,7 +113,7 @@ let greater_than_natural : Relation.t =
       (* Swap: right > left *)
       let attributes =
         Tuple.AttributeMap.of_list
-          [ ("left", Obj.magic right); ("right", Obj.magic left) ]
+          [ ("left", mk right); ("right", mk left) ]
       in
       Generator.Value
         ( Tuple.make_materialized ~relation:"greater_than" ~attributes,
@@ -130,7 +133,7 @@ let greater_than_or_equal_natural : Relation.t =
       let right = min a b in
       let attributes =
         Tuple.AttributeMap.of_list
-          [ ("left", Obj.magic left); ("right", Obj.magic right) ]
+          [ ("left", mk left); ("right", mk right) ]
       in
       Generator.Value
         ( Tuple.make_materialized ~relation:"greater_than_or_equal" ~attributes,
@@ -148,7 +151,7 @@ let equal_natural : Relation.t =
     | Some n ->
       let attributes =
         Tuple.AttributeMap.of_list
-          [ ("left", Obj.magic n); ("right", Obj.magic n) ]
+          [ ("left", mk n); ("right", mk n) ]
       in
       Generator.Value
         ( Tuple.make_materialized ~relation:"equal" ~attributes, generator )
@@ -166,7 +169,7 @@ let not_equal_natural : Relation.t =
       let left, right = if a = b then (a, b + 1) else (a, b) in
       let attributes =
         Tuple.AttributeMap.of_list
-          [ ("left", Obj.magic left); ("right", Obj.magic right) ]
+          [ ("left", mk left); ("right", mk right) ]
       in
       Generator.Value
         ( Tuple.make_materialized ~relation:"not_equal" ~attributes, generator )
@@ -192,7 +195,7 @@ let plus_natural : Relation.t =
       let s = a + b in
       let attributes =
         Tuple.AttributeMap.of_list
-          [ ("a", Obj.magic a); ("b", Obj.magic b); ("sum", Obj.magic s) ]
+          [ ("a", mk a); ("b", mk b); ("sum", mk s) ]
       in
       Generator.Value
         ( Tuple.make_materialized ~relation:"plus" ~attributes, generator )
@@ -233,7 +236,7 @@ let times_natural : Relation.t =
       let attributes =
         Tuple.AttributeMap.of_list
           [
-            ("a", Obj.magic a); ("b", Obj.magic b); ("product", Obj.magic p);
+            ("a", mk a); ("b", mk b); ("product", mk p);
           ]
       in
       Generator.Value
@@ -276,9 +279,9 @@ let minus_natural : Relation.t =
       let attributes =
         Tuple.AttributeMap.of_list
           [
-            ("a", Obj.magic a);
-            ("b", Obj.magic b);
-            ("difference", Obj.magic diff);
+            ("a", mk a);
+            ("b", mk b);
+            ("difference", mk diff);
           ]
       in
       Generator.Value
@@ -327,10 +330,10 @@ let divide_natural : Relation.t =
       let attributes =
         Tuple.AttributeMap.of_list
           [
-            ("a", Obj.magic a);
-            ("b", Obj.magic b);
-            ("quotient", Obj.magic q);
-            ("remainder", Obj.magic r);
+            ("a", mk a);
+            ("b", mk b);
+            ("quotient", mk q);
+            ("remainder", mk r);
           ]
       in
       Generator.Value