Anonymous avatar Anonymous committed 50207c7

Filepath: +to_segs, +rel_from

Comments (0)

Files changed (2)

     | [("" | ".") :: segs] -> norm1 ~acc segs
     | [(".." as seg) :: segs] ->
         match acc with
-        [ [] -> norm1 ~acc:[seg :: acc] segs
+        [ [] | [".." :: _] -> norm1 ~acc:[seg :: acc] segs
         | [_ :: acc_tl] -> norm1 ~acc:acc_tl segs
         ]
     | [h :: t] -> norm1 ~acc:[h :: acc] t
 ;
 
 
-value to_string (_kind, segs) =
+value segs_to_string segs =
   String.concat "/" segs
 ;
 
 
+value to_segs (_kind, segs) =
+  segs
+;
+
+
+value to_string p =
+  segs_to_string (to_segs p)
+;
+
+
+
+
 value abs ~base = fun
   [ (`Abs, _p_segs) as p -> p
   | (`Rel, p_segs) ->
   ]
 ;
 
+
+value map_nonempty_segs f segs =
+  loop segs
+  where rec loop segs =
+    match segs with
+    [ [] -> []
+    | [h :: t] ->
+        if h = ""
+        then loop t
+        else [f h :: loop t]
+    ]
+;
+
+
+value remove_last_slash segs =
+  loop segs
+  where rec loop segs =
+    match segs with
+    [ [] -> []
+    | ["" :: []] -> []
+    | [h :: t] -> [h :: loop t]
+    ]
+;
+
+
+(*
+     /a/b    /a/c -> ../c
+     /a/b/   /a/c -> ../c
+     /a/b    /a   -> ..
+
+     /a      /a/c -> c
+ *)
+
+
+value rel_from ~base p =
+  match (base, p) with
+  [ ((`Abs, []), _) | (_, (`Abs, [])) ->
+      assert False
+  | ((`Abs, [bh :: bsegs]), (`Abs, [ph :: psegs])) ->
+      ( assert (bh = "")
+      ; assert (ph = "")
+      ; inner bsegs psegs
+      )
+      where rec inner bsegs psegs =
+        (* let () = Printf.printf "b=%S p=%S\n%!" (segs_to_string bsegs)
+          (segs_to_string psegs) in *)
+        match bsegs with
+        [ ([] | ["" :: []]) ->
+            (`Rel, psegs)
+        | [bh :: bt] ->
+            match psegs with
+            [ [ph :: pt] when bh = ph ->
+                inner bt pt
+            | [] | [_ :: _] ->
+                (`Rel, (map_nonempty_segs (fun _ -> "..") bsegs) @ psegs)
+            ]
+        ]
+  ]
+;
+
+
+(*
+value () =
+  let r = (rel_from ~base:(`Abs, [""; "a"; "b"; ""]) (`Abs, [""; "a"; "c"])) in
+  Printf.printf "r=%S\n" (to_string r)
+  Printf.printf "%b" (
+    ( 
+    = (`Rel, [".."; "c"])
+    )
+  )
+;
+*)
 (* выдать строку из пути: *)
 value to_string : t any -> string;
 
+(* выдать список сегментов пути (для абсолютных путей первый всегда ""): *)
+value to_segs : t any -> list string;
+
 (* [abs ~base path] резолвит [path] относительно абсолютного пути [base]: *)
 value abs : ~base:(t abs) -> t any -> t abs;
 
    полного пути в случае, если сделали [chroot base] и внутри
    обращаются к пути [path] *)
 value root : ~base:(t abs) -> t abs -> t abs;
+
+(* [rel_from ~base p] равно относительному пути, по которому
+   доступен путь [p], если перейти в директорию [base] *)
+value rel_from : ~base:(t abs) -> t abs -> t rel;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.