Commits

camlspotter committed 2596f80

- Added String.is_space_or_tab and String.is_newline_or_return
- Added Sys.with_chdir
- Added Result.at_Error
* Removed String.split_by_newline since it is buggy. Added String.lines instead.
* String.chop_newline is now renamed as String.chop_eols with a bug fix
* Greatly simplyfied Exn
* Changed type of Result.from_Ok

Comments (0)

Files changed (15)

 - Added SpotStream.map
 - Added String.{sub', replace_chars, find}
 - Added Filepath
+- Added String.is_space_or_tab and String.is_newline_or_return
+- Added Sys.with_chdir
+- Added Result.at_Error
 * Largely rewritten Xunix's command/shell execution.
 * Added Shell for the shell command like functions
 * Added labels to At functions.
 * Stream.fold_right and fold_right1 were wrong. Shameful.
+* Removed String.split_by_newline since it is buggy. Added String.lines instead.
+* String.chop_newline is now renamed as String.chop_eols with a bug fix
+* Greatly simplyfied Exn
+* Changed type of Result.from_Ok
 
 2.3.0
 ------------
 let with_ref r v f =
   let back_v = !r in
   r := v;
-  Exn.protect ~f () ~finally:(fun () -> r := back_v)
+  Exn.protect f () ~finally:(fun () -> r := back_v)
     
 
 let with_oc oc f = 
-  Exn.protect' (fun () -> f oc) ~finally:(fun () -> close_out oc)
+  Exn.protect f oc ~finally:close_out
 
 let with_ic ic f = 
-  Exn.protect' (fun () -> f ic) ~finally:(fun () -> close_in ic)
+  Exn.protect f ic ~finally:close_in
 
 let (|-) res f = f res; res
 
 let invalid_argf fmt = Printf.kprintf invalid_arg fmt
 
 exception Finally of exn * exn
-;;
 
 (* CR jfuruse: looks lousy... *)
-let protect ~f v ~(finally : 'a -> unit) =
+let protect f v ~(finally : 'a -> unit) =
   let res =
     try f v
     with exn ->
   in
   finally v;
   res
-;;
 
-let catch ~f v = try `Ok (f v) with e -> `Error e;;
-let try_ignore ~f v = try f v with _ -> ();;
-let try_default ~default ~f v = try f v with _ -> default v;;
-let try_bool ~f v = try ignore (f v); true with _ -> false
-
-let with_final v f final = protect ~f ~finally:final v
-
-let protect' f ~(finally : unit -> unit) =
+let protect_with f v ~finally =
   let res =
-    try f ()
+    try f v
     with exn ->
-      (try finally () with final_exn -> raise (Finally (exn, final_exn)));
+      (try finally v with final_exn -> raise (Finally (exn, final_exn)));
       raise exn
   in
-  finally ();
-  res
-;;
+  res, finally v
 
-let protect'_with f ~finally =
-  let res =
-    try f ()
-    with exn ->
-      (try finally () with final_exn -> raise (Finally (exn, final_exn)));
-      raise exn
-  in
-  let res' = finally () in
-  res, res'
-;;
+let catch f v = try `Ok (f v) with e -> `Error e
 
-let catch' f = try `Ok (f ()) with e -> `Error e
-let try_ignore' f = try f () with _ -> ()
-let try_default' ~default f = try f () with _ -> default ();;
-let try_bool' f = try ignore (f ()); true with _ -> false
+let try_ignore f v = try f v with _ -> ()
+
+let try_or f g v = try f v with _ -> g v
+
+let try_bool f v = try f v; true with _ -> false
+
+let protect_ f = protect f ()
+let protect_with_ f = protect_with f ()
+let catch_ f = catch f ()
+let try_ignore_ f = try_ignore f ()
+let try_or_ f g = try_or f g ()
+let try_bool_ f = try_bool f ()
 
 let tee f v ~handler = try f v with e -> handler e; raise e
 
 
 exception Finally of exn * exn
 
-val protect     : f:('a -> 'b) -> 'a -> finally: ('a -> unit) -> 'b
-val with_final : 'a -> ('a -> 'b) -> ('a -> unit) -> 'b
-(** same as [protect] *)
-
-val catch       : f:('a -> 'b) -> 'a -> [> ('b, exn) Result.t ]
-val try_ignore  : f:('a -> unit) -> 'a -> unit
-val try_default : default: ('a -> 'b) -> f: ('a -> 'b) -> 'a -> 'b
-val try_bool    : f:('a -> 'b) -> 'a -> bool
+val protect     : ('a -> 'b) -> 'a -> finally: ('a -> unit) -> 'b
+(** It raises an exception [Finally (org, final)] when [finally] cannot recover the error. *)
+ 
+val protect_with : ('a -> 'b) -> 'a -> finally: ('a -> 'c) -> 'b * 'c
+(** It raises an exception [Finally (org, final)] when [finally] cannot recover the error. *)
+ 
+val catch       : ('a -> 'b) -> 'a -> [> ('b, exn) Result.t ]
+val try_ignore  : ('a -> unit) -> 'a -> unit
+val try_or      : ('a -> 'b) -> ('a -> 'b) -> 'a -> 'b
+val try_bool    : ('a -> 'b) -> 'a -> bool
 (** [true] at success *)
 
-val protect'      : (unit -> 'a) -> finally: (unit -> unit) -> 'a
-val protect'_with : (unit -> 'a) -> finally: (unit -> 'b) -> 'a * 'b
-val catch'        : (unit -> 'a) -> [> ('a, exn) Result.t ]
-val try_ignore'   : (unit -> unit) -> unit
-val try_default'  : default: (unit -> 'a) -> (unit -> 'a) -> 'a
-val try_bool'     : (unit -> unit) -> bool (* success/fail *)
-(** [true] at success *)
+val protect_      : (unit -> 'b) -> finally: (unit -> unit) -> 'b
+val protect_with_ : (unit -> 'b) -> finally: (unit -> 'c) -> 'b * 'c
+val catch_        : (unit -> 'b) -> [> ('b, exn) Result.t ]
+val try_ignore_   : (unit -> unit) -> unit
+val try_or_       : (unit -> 'b) -> (unit -> 'b) -> 'b
+val try_bool_     : (unit -> 'b) -> bool
+
 
 val tee : ('a -> 'b) -> 'a -> handler:(exn -> unit) -> 'b
 (** [tee f v ~handler]. If [f v] raises an exception [e], 
 
 let iter_lines_exn fname f =
   let ic = open_in fname in
-  protect () 
+  ~~ protect () 
     ~f:(fun () ->
       let rec iter () = f (input_line ic); iter () in
       try iter () with Exit | End_of_file -> ())
 ;;
 
 let iter_lines fname f =
-  catch () ~f:(fun () -> iter_lines_exn fname f)
+  ~~ catch () ~f:(fun () -> iter_lines_exn fname f)
 ;;
 
 let to_lines fname =
 
 let open_out string f =
   let oc = open_out string in
-  protect () ~f:(fun () -> f oc) ~finally:(fun _ -> close_out oc)
+  protect f oc ~finally:(fun _ -> close_out oc)
 ;;
 
 let write_lines p lines = 
   let ok x = `Ok x
   let ng x = `Error x
 
-  let from_Ok to_exn = function
+  exception Error
+
+  let from_Ok = function
     | `Ok v -> v
-    | `Error e -> raise (to_exn e)
+    | `Error _ -> raise Error
   
   let result left right = function
     | `Ok v -> left v
     | `Error e -> right e
 
+  let at_Error f = result (fun x -> x) f
 end
 
 include Pervasives
     If an exception [exn] raised in [f ()], [catch f] returns [`Error exn].
 *)
 
-val from_Ok : ('error -> exn) -> [< ('a, 'error) t] -> 'a
+exception Error
+
+val from_Ok : [< ('a, 'error) t] -> 'a
+(** Haskell's fromJust *)
 
 val result : ('a -> 'b) -> ('c -> 'b) -> [< ('a, 'c) t] -> 'b
 (** Haskell's either *)
 val (>>|!) : ('a, 'e) t -> ('e -> 'e2) -> ('a, 'e2) t  
 (** mapE *)
 
+val at_Error : ('err -> 'a) -> [< ('a, 'err) t] -> 'a
+(** [at_Error = result id] *)
+
 module Pervasives : sig
   val ok : 'a -> [> `Ok of 'a ]
   val ng : 'a -> [> `Error of 'a ]
   (** No Good *)
 
-  val from_Ok : ('error -> exn) -> [< ('a, 'error) t] -> 'a
+  val from_Ok : [< ('a, 'error) t] -> 'a
 
   val result : ('a -> 'b) -> ('c -> 'b) -> [< ('a, 'c) t] -> 'b
   (** Haskell's either *)
+
+  val at_Error : ('err -> 'a) -> [< ('a, 'err) t] -> 'a
+  (** [at_Error = result id] *)
 end
 
       else true
  
   TEST "is_valid" =
-    is_valid (Result.from_Ok (fun _ -> assert false) & of_string "2000-04-01")
+    is_valid (Result.from_Ok & of_string "2000-04-01")
 
   TEST "is_valid" =
-    not & is_valid (Result.from_Ok (fun _ -> assert false) & of_string "2000-04-31")
+    not & is_valid (Result.from_Ok & of_string "2000-04-31")
   
   TEST "is_valid" =
-    is_valid (Result.from_Ok (fun _ -> assert false) & of_string "2000-02-29")
+    is_valid (Result.from_Ok & of_string "2000-02-29")
   
   let random () =
     let year = Random.int 200 + 1900 in
 
   TEST "diff" = 
     diff 
-      (Result.from_Ok (fun _ -> assert false) & of_string "2013-06-01")
-      (Result.from_Ok (fun _ -> assert false) & of_string "2012-01-31") 
+      (Result.from_Ok & of_string "2013-06-01")
+      (Result.from_Ok & of_string "2012-01-31") 
     = 366 - 31 + 31 + 28 + 31 + 30 + 31 + 1
 end
 
 
   TEST_UNIT "Date.Unix" = 
     let open Unix in
-    let t = Result.from_Ok (fun _ -> assert false) & of_string "2000-04-01" in
+    let t = Result.from_Ok & of_string "2000-04-01" in
     let _, tm, inv = Option.from_Some & tm_of_date t in
     assert ((tm.tm_year, tm.tm_mon, tm.tm_mday, inv) = (2000 - 1900, 4 - 1, 1, `Ok))
 
     Gc.stat ()
   in
 
-  Exn.protect'_with (fun () -> f v)
-    ~finally:(fun () ->
+  Exn.protect_with f v
+    ~finally:(fun _ ->
       let stat_after =
         Gc.compact ();
         Gc.stat ()
     index_rec s (to_+1) from c
 ;;
 
-let chop_newline s =
-  let len = String.length s in
-  if len > 1 && s.[len-1] = '\n' then
-    if len > 2 && s.[len-2] = '\r' then String.sub s 0 (len-2)
-    else String.sub s 0 (len-1)
+let chop_eols s =
+  let len = length s in
+  if len > 1 then
+    match s.[len-1] with
+    | '\n' -> 
+        if len > 2 && s.[len-2] = '\r' then sub s 0 (len-2)
+        else sub s 0 (len-1)
+    | '\r' -> sub s 0 (len-1)
+    | _ -> s
   else s
 
+TEST "chop_eols" =
+      chop_eols "a" = "a"
+      && chop_eols "a\n" = "a"
+      && chop_eols "a\r\n" = "a"
+      && chop_eols "a\r" = "a"
+
 let sub_from_to s from to_ = 
   if from > to_ then invalid_arg "sub_from_to";
   String.sub s from (to_ - from + 1)
 
-let split_by_newline s =
-  let length = String.length s in
+let is_space_or_tab = function ' ' | '\t' -> true | _ -> false
+let is_newline_or_return = function '\n' | '\r' -> true | _ -> false
+
+let get_opt s pos = try Some (get s pos) with _ -> None
+
+let lines s =
   let rec aux st start_pos pos = 
-    if pos = length then List.rev st else match s.[pos] with
-    | '\r' | '\n' -> 
-        let st = String.sub s start_pos (pos - start_pos) :: st in
-        skip st (pos+1)
+    match get_opt s pos with
+    | None (* eos *) ->
+        List.rev (
+          if start_pos = pos then st
+          else (sub s start_pos (pos - start_pos), "") :: st
+        )
+    | Some '\n' ->
+        aux ((sub s start_pos (pos - start_pos), "\n") :: st) (pos+1) (pos+1)
+    | Some '\r' ->
+        begin match get_opt s (pos+1) with
+        | Some '\n' ->
+            aux ((sub s start_pos (pos - start_pos), "\r\n") :: st) (pos+2) (pos+2)
+        | _ ->
+            aux ((sub s start_pos (pos - start_pos), "\r") :: st) (pos+1) (pos+1)
+        end
     | _ -> aux st start_pos (pos+1)
-  and skip st pos = 
-    if pos = length then List.rev st else match s.[pos] with
-    | '\r' | '\n' -> skip st (pos+1)
-    | _ -> aux st pos (pos+1)
   in
   aux [] 0 0
 
+TEST "lines" = 
+      let ss = lines "hello\nworld\r\ngood\rday" in
+      let res = ss = ["hello", "\n"; "world", "\r\n"; "good", "\r"; "day", ""] in
+      if not res then List.iter (fun (x,y) -> Printf.eprintf "%S,%S\n" x y) ss;
+      res
+
+TEST "lines" = 
+      lines "\na\nb\rc\r\nd\n\re\n\nf\ng" = [ ""  , "\n";
+                                              "a" , "\n";
+                                              "b" , "\r";
+                                              "c" , "\r\n";
+                                              "d" , "\n";
+                                              ""  , "\r";
+                                              "e" , "\n";
+                                              ""  , "\n";
+                                              "f" , "\n";
+                                              "g" , "" ] 
+
+
 (* split a string according to char_sep predicate *)
 let split char_sep str =
   let len = String.length str in
     let wstart = skip_sep 0 in
     split wstart wstart
 
+TEST "split" = 
+        split (function ' ' -> true | _ -> false) " hello  world " = ["hello"; "world"]
+
 let make1 = String.make 1
 
 module Set = Xset.Make(struct type t = string let compare (x:string) y = compare x y end)
 
 module Pervasives = struct
-  let chop_newline = chop_newline
-  let split_by_newline = split_by_newline
+  let chop_eols = chop_eols
 end
 
 let split_at len str = String.sub str 0 len, String.sub str len (String.length str - len)
 
-TEST_UNIT "Xstring.split_at" = 
-    assert (split_at 3 "hello world" = ("hel", "lo world"))
+TEST "Xstring.split_at" = 
+    split_at 3 "hello world" = ("hel", "lo world")
 ;;
 
 let take len str = String.sub str 0 len
 let drop len str = String.sub str len (String.length str - len)
 let drop_postfix len str = String.sub str 0 (String.length str - len)
 
-TEST_UNIT "Xstring.drop_postfix" = 
-    assert (drop_postfix 6 "hello world" = "hello")
+TEST "Xstring.drop_postfix" = 
+    drop_postfix 6 "hello world" = "hello"
 ;;
 
 let postfix len str = 
   let l = String.length str in
   String.sub str (l-len) len
 
-TEST_UNIT "Xstring.drop_postfix" = 
-    assert (postfix 5 "hello world" = "world")
+TEST "Xstring.drop_postfix" = 
+    postfix 5 "hello world" = "world"
 ;;
 
 let is_prefix' ?(from=0) sub str =
     else None
   with _ -> None
 
-TEST_UNIT "Xstring.is_prefix'" = 
-    assert (is_prefix' "hello" "hello world" = Some " world")
+TEST "Xstring.is_prefix'" = 
+    is_prefix' "hello" "hello world" = Some " world"
 ;;
 
 let is_prefix ?(from=0) sub str =
     String.sub str from sublen = sub
   with _ -> false
 
-TEST_UNIT "Xstring.is_prefix" = 
-    assert (is_prefix "hello" "hello world")
+TEST "Xstring.is_prefix" = 
+    is_prefix "hello" "hello world"
 ;;
 
 let is_substring ?from:(pos=0) ~needle:sub str =
   let sublen = String.length sub in
   try postfix sublen str = sub with _ -> false
   
-TEST_UNIT "Xstring.is_postfix" = 
-    assert (is_postfix "world" "hello world")
+TEST "Xstring.is_postfix" = 
+    is_postfix "world" "hello world"
 ;;
 
 let is_postfix' sub str =
     else None
   with _ -> None
 
-TEST_UNIT "Xstring.is_postfix" = 
-    assert (is_postfix' "world" "hello world" = Some "hello ")
+TEST "Xstring.is_postfix" = 
+    is_postfix' "world" "hello world" = Some "hello "
 ;;
 
 let index_string_from str pos sub =
+val get_opt : string -> int -> char option
+
 val is_substring : ?from:int -> needle:string -> string -> bool
 
 val is_prefix : ?from:int -> string -> string -> bool
 
 val sub_from_to : string -> int -> int -> string
 
-val chop_newline : string -> string
-(** [chop_newline s] returns the string [s] w/o the newline chars at the end.
-    [chop_newline "hello\r\n" = "hello"]
-    [chop_newline "hello\n" = "hello"]
-    [chop_newline "hello" = "hello"]
+val chop_eols : string -> string
+(** [chop_eols s] returns the string [s] w/o the end-of-line chars. [chop] from Perl.
+    [chop_eols "hello\r\n" = "hello"]
+    [chop_eols "hello\n" = "hello"]
+    [chop_eols "hello\r" = "hello"]
+    [chop_eols "hello" = "hello"]
 *)
 
+val is_space_or_tab : char -> bool
+val is_newline_or_return : char -> bool
+
 val make1 : char -> string
 (** [make1 = String.make 1] *) 
 
-val split_by_newline : string -> string list
+val lines : string -> (string * string) list
+(** [lines "hello\nworld\r\ngood\rday" = ["hello", "\n"; "world", "\r\n"; "good", "\r"; "day", ""]  *)
+
 val split : (char -> bool) -> string -> string list
+(** [split (function ' ' -> true | _ -> false) "hello      world" = ["hello"; "world"] *) 
 
 module Set : Xset.S with type elt = String.t
 
 end
 
 module Pervasives : sig
-  val chop_newline : string -> string
-  val split_by_newline : string -> string list
+  val chop_eols : string -> string
 end
 
 val sub' : string -> int -> int -> string
 let must fmt = Printf.kprintf (fun s -> if Sys.command s <> 0 then Exn.failwithf "command %s failed" s) fmt
 let cp = must "/bin/cp %s %s"
 let patch_p1 = must "/bin/patch -p1 < %s"
+
+let with_chdir d f v =
+  let cwd = Sys.getcwd () in
+  Exn.protect 
+    (fun () -> 
+      Sys.chdir d;
+      f v)
+    ()
+    ~finally:(fun () -> Sys.chdir cwd)
+
+let with_chdir_ d f = with_chdir d f ()
 val must : ('a, unit, string, unit) format4 -> 'a
 val cp : string -> string -> unit
 val patch_p1 : string -> unit
+
+val with_chdir : string -> ('a -> 'b) -> 'a -> 'b
+(** may raise [Invalid_arg "Xsys.with_chdir"] *)
+
+val with_chdir_ : string -> (unit -> 'b) -> 'b
+(** [with_chdir_ d f = with_chdir d f ()] *)
 (* run [f] on files in [path] *)
 let folddir ~f ~init path =
   let dh = opendir path in
-  Exn.protect' (fun () ->
+  ~~ Exn.protect () ~f:(fun () ->
     let rec loop st =
       try
         let st' = f st (readdir dh) in
 
   type 'a result = Unix.process_status * 'a
 
-  let failwith ?name = 
+  let fail ?name = 
     let name = match name with None -> "" | Some n -> n ^ ": " in
     function
       | WEXITED n  , _ -> Exn.failwithf "%sprocess exited with id %d" name n
 
   let must_exit_with ?name n = function
     | (WEXITED m, res) when n = m -> res
-    | r -> failwith ?name r
+    | r -> fail ?name r
 
   let from_exit ?name = function
     | WEXITED m, r -> m, r
-    | e -> failwith ?name e
+    | e -> fail ?name e
 
   let buf_flush_limit = 100000
   
 
   let print ?prefix com = 
     let with_prefix s = 
-      let s = Xstring.chop_newline s in
+      let s = Xstring.chop_eols s in
       match prefix with
       | None -> s
       | Some p -> p ^ ": " ^ s
   let get_stdout com = 
     let pst, rev =
       com ~init:[] ~f:(fun rev -> function
-        | `Err, `Read s -> prerr_endline & Xstring.chop_newline s; rev
+        | `Err, `Read s -> prerr_endline & Xstring.chop_eols s; rev
         | `Out, `Read s -> s :: rev
         | _ -> rev)
     in
 
 let with_dtemp template f =
   let d = mkdtemp template in
-  Exn.protect' (fun () -> f d) ~finally:(fun () ->
+  Exn.protect f d ~finally:(fun _ ->
     if ksprintf Sys.command "/bin/rm -rf %s" d <> 0 then
       Exn.failwithf "Unix.with_dtemp: cleaning tempdir %s failed" d)
   
 let with_chdir ?(at_failure=(fun exn -> raise exn)) dir f =
   let cwd = Unix.getcwd () in
-  match Exn.catch ~f:Unix.chdir dir with
+  match Exn.catch Unix.chdir dir with
   | `Error exn -> at_failure exn
   | `Ok () ->
-      Exn.protect' f ~finally:(fun () -> Unix.chdir cwd)
+      Exn.protect f () ~finally:(fun () -> Unix.chdir cwd)
     
   (** Result tools
   *)
 
-  val failwith : ?name:string -> 'res result -> 'no_return
+  val fail : ?name:string -> 'res result -> 'no_return
   val from_exit : ?name:string -> 'res result -> int * 'res
   val must_exit_with : ?name:string -> int -> 'res result -> 'res
   val should_exit_with : int -> 'res result -> ('res, Unix.process_status * 'res) Result.t