Commits

Anonymous committed 39e5a1f

.

  • Participants
  • Parent commits 70b4d97

Comments (0)

Files changed (1)

File amall_http_service.ml

     ;
 
 
-    exception Already_handled of http_service_func
+    exception Already_handled
     ;
 
 
+    value go_or_create_smallstep ~fb ~disp ~seg : disp_level =
+      match disp.seg_map#get_opt seg with
+      [ None ->
+          let lev =
+            { seg_map = new c_seg_map
+            ; fallback = fb
+            } in
+          ( mount_point.seg_map#add seg (Level lev)
+          ; lev
+          )
+      | Some (Level lev) -> lev
+      | Some (Service f) -> raise Already_handled
+      ]
+    ;
+
+
+    value rec go_or_create_bigstep ~fb ~disp ~segs : disp_level =
+      match segs with
+      [ [] -> disp
+      | [seg :: segs] ->
+          go_or_create_bigstep
+            ~fb
+            ~disp:(go_or_create_smallstep ~fb ~disp ~seg)
+            ~segs
+      ]
+    ;
+
+
     value install_handler
-      (how : [= `Service | `Fallback ])
-      (what : http_service_func)
-      (mount_point : mount_point)
-      (segpath : segpath)
+      (~how_where : [= `Service of (segpath * seg) | `Fallback of segpath ])
+      (~mount_point : mount_point)
+      (~what : http_service_func)
      :
       unit
     =
-      match segpath with
-      [ [] ->
+      let segpath =
+        match how_where with
+        [ `Service (s, _) -> s
+        | `Fallback s -> s
+        ]
+      in
+      let disp_level = go_or_create_bigstep
+        ~fb:default_fallback
+        ~disp:mount_point
+        ~segs:segpath
+      in
+      .
+
+        install_handler how what went_or_created segpath
+      match how_where with
+      [ `Service ([], seg) ->
+          inst serv
+      | `Fallback [] ->
+          inst fb
+      | `Service 
+
           match how with
           [ `Fallback -> mount_point.fallback := what
           | `Service -> ... логика разная слегка, рассмотреть корень.
           ]
       | [seg :: segpath] ->
-          let went_or_created =
-            match mount_point.seg_map#get_opt seg with
-            [ None ->
-                let lev =
-                  { seg_map = new c_seg_map
-                  ; fallback = default_fallback
-                  } in
-                ( mount_point.seg_map#add seg (Level lev)
-                ; lev
-                )
-            | Some (Level lev) -> lev
-            | Some (Service f) -> raise (Already_handled f)
-            ]
-          in
-            install_handler how what went_or_created segpath
       ]
     type disp_level =
       { seg_map : seg_map