Commits

Dmitry Grebeniuk  committed 6ca9c72

Filepath: moar polymorphism

  • Participants
  • Parent commits 50207c7

Comments (0)

Files changed (2)

File src/filepath.ml

 type abs = [= `Abs ]
  and rel = [= `Rel ]
- and any = [= `Abs | `Rel ]
+ and unk = [= `Abs | `Rel ]
 ;
 
 
 
 value rec of_segs segs =
   match segs with
-  [ [] -> ((rel_of_segs [] (* ? хз. *) ) :> t any)
-  | ["" :: (["" :: _] as segs)] -> ((of_segs segs) :> t any)
-  | ["" :: _] -> ((abs_of_segs segs) :> t any)
-  | segs -> ((rel_of_segs segs) :> t any)
+  [ [] -> ((rel_of_segs [] (* ? хз. *) ) :> t unk)
+  | ["" :: (["" :: _] as segs)] -> ((of_segs segs) :> t unk)
+  | ["" :: _] -> ((abs_of_segs segs) :> t unk)
+  | segs -> ((rel_of_segs segs) :> t unk)
   ]
 ;
 
 
-value of_string s : t any =
+value of_string s : t unk =
   of_segs (String.split_exact ( (=) '/' ) s)
 ;
 

File src/filepath.mli

 (* вид пути: *)
 type abs = [= `Abs ]
  and rel = [= `Rel ]
- and any = [= `Abs | `Rel ]
+ and unk = [= `Abs | `Rel ]
 ;
 
 (* путь в виде значения приватного типа: *)
 ;
 
 (* создать путь из списка сегментов: *)
-value of_segs : list string -> t any;
+value of_segs : list string -> t unk;
 
 (* создать путь из строки: *)
-value of_string : string -> t any;
+value of_string : string -> t unk;
 
 (* классифицировать путь: *)
-value classify : t any -> [= `Abs of t abs | `Rel of t rel];
+value classify : t [= abs | rel | unk] -> [= `Abs of t abs | `Rel of t rel];
 
 (* выдать строку из пути: *)
-value to_string : t any -> string;
+value to_string : t 'a -> string;
 
 (* выдать список сегментов пути (для абсолютных путей первый всегда ""): *)
-value to_segs : t any -> list string;
+value to_segs : t 'a -> list string;
 
-(* [abs ~base path] резолвит [path] относительно абсолютного пути [base]: *)
-value abs : ~base:(t abs) -> t any -> t abs;
+(* [abs ~base path] резолвит [path] относительно абсолютного пути [base],
+   если [path] является относительным путём: *)
+value abs : ~base:(t abs) -> t [= abs | rel | unk] -> t abs;
 
 (* обрезать из абсолютного пути всё, что пытается выйти выше корня: *)
 value not_above_root : t abs -> t abs;