Commits

Anonymous committed 43a07d6

.

Comments (0)

Files changed (5)

 With_comb
 Amall_http
 Amall_http_server
+Amall_http_service
 Amall_types
 Uri_type
 Uri
 value max_header_len = 4096;
 value max_headers_size = 10240;
 
+type listen_addr =
+  [= `Inet_any of port
+  |  `Inet_loopback of port
+  |  `Inet_str of (addr_string * port)
+  |  `Inet_addr of (Unix.inet_addr * port)
+  ]
+;
+
 type request_method = [= `GET | `POST | `HEAD ]
 ;
 

amall_http_server.ml

 type port = int;
 type addr_string = string;
 
-type listen_addr =
-  [= `Inet_any of port
-  |  `Inet_loopback of port
-  |  `Inet_str of (addr_string * port)
-  |  `Inet_addr of (Unix.inet_addr * port)
-  ]
-;
-
 module Http_server
   (IO : IO_Type)
   (I : It_type.IT with module It_IO = IO)
       I.iteratee char (request * list (string * string))
     ;
 
-    value run : listen_addr -> http_server_func -> IO.server
+    value run : Amall_http.listen_addr -> http_server_func -> IO.server
     ;
 
   end

amall_http_service.ml

 (* Services to process http requests to specific pages
    from Amall_http_server. *)
+
+open Amall_types;
+open Am_Ops;
+open Printf;
+
+module Cadastr
+ =
+  struct
+
+    (* non-specific types *)
+
+    module T
+     =
+      struct
+
+        class map_ro ['k, 'v] =
+          object (self)
+
+            method get_exn (k : 'k) : 'v =
+              match self#get_opt k with
+              [ None -> raise Not_found
+              | Some v -> v
+              ]
+            ;
+
+            method get_opt (k : 'k) : option 'v =
+              try Some (self#get_exn k)
+              with [ Not_found -> None ]
+            ;
+
+          end
+        ;
+
+      end
+    ;
+
+
+    (* types of imperative/mutable structures *)
+
+    module TImp
+     =
+      struct
+
+        class virtual map_rw ['k, 'v] =
+          object (self)
+
+            inherit T.map_ro ['k, 'v];
+
+            method virtual add : 'k -> 'v -> unit;
+
+            method virtual remove : 'k -> unit;
+
+            method replace (k : 'k) (v : 'v) =
+              ( self#remove k
+              ; self#add k v
+              )
+            ;
+
+          end
+        ;
+
+      end
+    ;
+ end
+;
+
+
+open Cadastr
+;
+
+open Amall_http_server
+;
+
+
+module Service
+  (IO : IO_Type)
+  (I : It_type.IT with module It_IO = IO)
+ :
+  sig
+
+    type seg = string;
+
+    (* segpath contains path from uri, split by '/' and normalized. *)
+    type segpath = list seg;
+
+    type http_server_func
+     (* = (Http_server(IO)(I)).http_server_func *)
+     = Amall_http.request -> I.iteratee char Amall_http.response
+    ;
+
+    (* Service receives path components relative to "mount point".
+       for example, when service is registered on
+       "http://host:port/a/b/c" and when
+
+       request uri is:                 segpath is:
+       http://host:port/a/b/c          [""]
+       http://host:port/a/b/c/         [""]
+       http://host:port/a/b/c/d/e      ["d"; "e"]
+       http://host:port/a/b/c/d?e#f    ["d"]
+     *)
+
+    type http_service_func =
+      segpath -> http_server_func
+    ;
+
+    type mount_point
+    ;
+
+    value run_listener : Amall_http.listen_addr -> mount_point
+    ;
+
+  end
+ =
+  struct
+
+    module HS = Http_server(IO)(I);
+
+    type http_server_func = HS.http_server_func
+    ;
+
+    type seg = string
+    ;
+
+    type segpath = list string
+    ;
+
+    type http_service_func =
+      list seg -> http_server_func
+    ;
+
+    value default_fallback =
+      (* дать ответ 404 *) failwith "404"
+    ;
+
+    type disp_level =
+      { seg_map : TImp.map_rw seg disp_handler
+      ; fallback : disp_handler
+      }
+    and disp_handler =
+      [ Level of disp_level
+      | Service of http_service_func
+      ]
+    ;
+
+    type listener =
+      { io_server : IO.server
+      ; disp : disp_handler
+      }
+    ;
+
+    type mount_point =
+      [ Listener of listener
+      | Disp of disp_level
+      ]
+    ;
+
+    class ..
+
+    value run_listener addr =
+      Listener (
+        let root =
+
+        let io_server = HS.run addr server_func in
+
+        { io_server = io_server
+        ; disp.. = ..
+        }
+      )
+    ;
+
+  end
+;
         value open_in : string -> m input_channel;
         value close_in : input_channel -> m unit;
         value read_into : input_channel -> string -> int -> int -> m int;
-        value runIO : m 'a -> It_Types.res 'a;
+        value runIO : m 'a -> [= `Error of exn | `Ok of 'a ];
       end;
     module Subarray :
       sig