(* string  utility routines for ocaml
   Copyright (C) 2002, 2003,2004 Shawn Wagner <shawnw@speakeasy.org>

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.
	 
   This library is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.
	 
   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)

(* Returns the string minus trailing whitespace *)
let chomp str =
  let c = ref true in
  let p = ref (String.length str) in
    while !c do
      if !p <= 0 then begin
        p := 0; c := false;
      end else begin
        if CharExtras.is_space (String.unsafe_get str (!p - 1)) then decr p
        else c := false end
    done;
    String.sub str 0 !p
      
(* Returns the first word of a string *)
let first_word str =
  try
    let len = String.index_from str 1 ' ' in
      String.sub str 0 len
  with
    | Not_found -> str

(* Returns everything after the character. *)
let split_at ~str ~sep  =
  try
    let p = String.index str sep in
    let len = String.length str - p - 1 
    and pos = succ p in
      String.sub str pos len
  with
    | Not_found -> ""

(* Cuts off the first character of a string and returns the rest *)
let cut_first_char str =
  let slen = String.length str in
  let len = pred slen in 
    String.sub str 1 len

(* Cuts off the last character of a string and returns the rest *)
let cut_last_char str = 
  let len = String.length str - 1 in
    String.sub str 0 len

(* Cuts off the first word of a string and returns the rest *)
let rec cut_first_word str =
  let rest = split_at str ' ' in
    try
      let rest_cut = cut_first_char rest in 
	if String.sub rest 0 1 = " " then
	  cut_first_word rest_cut
	else
	  rest
    with
      | Not_found -> rest

(* Concatenates a list of strings with a null seperator *)
let combine lst =
  String.concat "" lst

(* Return str minus the first n characters *)
let cut_first_n str n =
  let len = String.length str in
    if n > len then
      ""
    else
      String.sub str n (len - n)

(* Return str minus the last n characters *)
let cut_last_n str n = 
  let len = String.length str in
    if n > len then
      ""
    else
      String.sub str 0 (len - n)


let make_search_vec needle def =
  let v = Array.make 255 def in
    for n = 0 to (String.length needle) - 1 do
      v.(Char.code (String.unsafe_get needle n)) <- not def
    done;
    v

let rec checkt vec hay pos max =
  if pos >= max then
    raise Not_found
  else if vec.(Char.code hay.[pos]) then
    pos
  else
    checkt vec hay (pos + 1) max

let rec rcheckt vec hay pos =
  if pos < 0 then
    raise Not_found
  else if vec.(Char.code hay.[pos]) then
    pos
  else
    rcheckt vec hay (pos - 1)

let first_of_from needle haystack pos =
  let need = make_search_vec needle false in
    checkt need haystack pos (String.length haystack)

let last_of_from needle haystack pos =
  let need = make_search_vec needle false in
    rcheckt need haystack pos 
      
let first_not_of_from needle haystack pos =
  let need = make_search_vec needle true in
    checkt need haystack pos (String.length haystack)

let last_not_of_from needle haystack pos =
  let need = make_search_vec needle true in
    rcheckt need haystack pos 

let first_of needle haystack = first_of_from needle haystack 0 
let first_not_of needle haystack = first_not_of_from needle haystack 0

let last_of needle haystack =
  last_of_from needle haystack ((String.length haystack) - 1)
let last_not_of needle haystack =
  last_not_of_from needle haystack ((String.length haystack) - 1)

let map f str =
  let len = String.length str in
  let nstr = String.create len in
    for n = 0 to len - 1 do
      String.unsafe_set nstr n (f (String.unsafe_get str n))
    done;
    nstr

let mapi f str =
  let len = String.length str in
  let nstr = String.create len in
    for n = 0 to len - 1 do
      String.unsafe_set nstr n (f (String.unsafe_get str n) n)
    done;
    nstr
      
let map_inplace f str =
  let len = String.length str in
    for n = 0 to len - 1 do
      String.unsafe_set str n (f (String.unsafe_get str n))
    done

let mapi_inplace f str =
  let len = String.length str in
    for n = 0 to len - 1 do
      String.unsafe_set str n (f (String.unsafe_get str n) n)
    done

let iteri f str =
  let len = String.length str in
    for n = 0 to len - 1 do
      f (String.unsafe_get str n) n
    done

let fold_left f x s =
  let len = String.length s 
  and r = ref x in
    for i = 0 to len - 1 do
      r := f !r (String.unsafe_get s i)
    done;
    !r

let fold_right f s x =
  let len = String.length s 
  and r = ref x in
    for i = len - 1 downto 0 do
      r := f !r (String.unsafe_get s i) 
    done;
    !r

let uppercase = map CharExtras.to_upper
let lowercase = map CharExtras.to_lower

let capitalize str = 
  if String.length str = 0 then ""
  else
    let nstr = String.copy str in
      String.unsafe_set nstr 0 (CharExtras.to_upper (String.unsafe_get nstr 0));
      nstr

let uncapitalize str = 
  if String.length str = 0 then ""
  else
    let nstr = String.copy str in
      String.unsafe_set nstr 0 (CharExtras.to_lower (String.unsafe_get nstr 0));
      nstr


let startletter = Pcre.regexp "\\b\\w"

let titlecase str' =
  let str = lowercase str' in
    Pcre.substitute ~rex:startletter
      ~subst:uppercase str  

let prefix pref str =
  let plen = String.length pref in
    if plen > String.length str then false
    else if plen = String.length str then compare pref str = 0
    else let p = ref 0 in
      while !p < plen && pref.[!p] = str.[!p] do
	incr p
      done;
      !p = plen

let suffix suf str =
  let slen = String.length suf 
  and len = String.length str in
    if slen > len then false
    else if slen = len then compare suf str = 0
    else let p = ref (slen - 1) 
	 and n = ref (len - 1) in
      while !p >= 0 && suf.[!p] = str.[!n] do
	decr p;
	decr n;
      done;
      !p = -1

let rec find_str find flen str slen pos =
  let fp = ref 0 
  and sp = ref pos in
    while !fp < flen && !sp < slen && find.[!fp] = str.[!sp] do
      incr fp;
      incr sp;
    done;
    if !fp = flen then
      pos
    else
      find_str find flen str slen (String.index_from str (pos + 1) find.[0])

let index_substr_from find str pos =
  if find = "" then 0
  else if str = "" then raise Not_found
  else
    find_str find (String.length find) str (String.length str)
      (String.index_from str pos find.[0])
      

let index_substr find str = index_substr_from find str 0  

let match_substr find str pos =
  let slen = String.length str in
    if pos < 0 || pos >= slen then
      raise (Invalid_argument "StrExtras.match_substr")
    else
      let fp = ref 0
      and flen = String.length find 
      and sp = ref pos in
	while !fp < flen && !sp < slen && find.[!fp] = str.[!sp] do
	  incr fp;
	  incr sp;
	done;
	!fp = flen

let center ?(pad=' ') ?(trunc=false) src width =
  let len = String.length src in
    if len >= width then begin
      if trunc then
	String.sub src 0 width
      else
	String.copy src
    end else 
      let space = (width - len) / 2 in
      let centered = String.make width pad in
	String.blit src 0 centered space len;
	centered

let rev s =
  let str = String.copy s in
  let n = ref 0
  and p = ref ((String.length str) - 1) in
    while !n < !p do
      let tmp = String.unsafe_get str !n in
	String.unsafe_set str !n (String.unsafe_get str !p);
	String.unsafe_set str !p tmp;
	incr n;
	decr p;
    done;
    str

let implode lst =
  let str = String.create (List.length lst) in
  let pos = ref 0 in
    List.iter (fun c -> str.[!pos] <- c; incr pos) lst;
    str

let explode str =
  let res = ref [] in
  let rstr = rev str in
    String.iter (fun c -> res := c :: !res) rstr;
    !res

let right str n =
  let len = String.length str in
    if n >= len then
      String.copy str
    else
      String.sub str (len - n) n
    
let left str n =
  let len = String.length str in
    if n >= len then
      String.copy str
    else
      String.sub str 0 len

let ljust ?(pad=' ') ?(trunc=false) str n =
  let len = String.length str in
    if len >= n then begin
      if trunc then
	String.sub str 0 n
      else 
	String.copy str
    end else 
      let newstr = String.make n pad in
	String.blit str 0 newstr 0 len;
	newstr

let rjust ?(pad=' ') ?(trunc=false) str  n =
  let len = String.length str in
    if len >= n then begin
      if trunc then
	String.sub str 0 n
      else 
	String.copy str
    end else 
      let newstr = String.make n pad in
	String.blit str 0 newstr (n - len) len;
	newstr

let subpos str start stop =
  let len = stop - start + 1 in
    String.sub str start len

type trim_style = [ `Both | `Left | `Right ]

let trim ?(style=`Both) str ch =
  try
    let x = String.make 1 ch in
      match style with
	| `Left -> cut_first_n str (first_not_of x str)
	| `Right -> subpos str 0 (last_not_of x str)
	| `Both -> begin
	    let r = cut_first_n str (first_not_of x str) in
	      try
		subpos r 0 (last_not_of x r)
	      with 
		| Not_found -> r
	  end
 with
   | Not_found -> String.copy str

let repeat str times =
  let len = String.length str in
  let newstr = String.create (times * len) in
    for n = 0 to times - 1 do
      String.unsafe_blit str 0 newstr (n * len) len
    done;
    newstr

external collate: string -> string -> int = "stew_strcoll"

module Collate = struct
  type t = string
  let compare a b = collate a b
  let equal a b = (collate a b) = 0
  let hash = Hashtbl.hash 
end

let compare_insensitive s1 s2 =
  let ucs1 = uppercase s1
  and ucs2 = uppercase s2 in
    String.compare ucs1 ucs2

module CaseInsensitive = struct
  type t = string
  let compare a b = compare_insensitive a b
  let equal a b = (uppercase a) = (uppercase b)
  let hash a = Hashtbl.hash (uppercase a)
end

module FastSearch = struct
  type t = {
    skips: int array;
    orig: string;
    len: int;
  }

  let study str =
   let len = String.length str in
   let tab = { skips = Array.make 256 len; orig = String.copy str; len = len } in
      for i = 0 to len - 1 do
	tab.skips.(Char.code str.[i]) <- len - i - 1
      done;
     tab
	
       (* alen is shorter *)
  let rec equal_at a alen b blen i x =
    if x = alen - 1 then
      a.[x] = b.[i + x]
    else if a.[x] = b.[i + x] then
      equal_at a alen b blen i (x + 1)
    else
      false

  let rec do_index tab hay hlen i =
    if i <= hlen - tab.len then begin
      let c  = hay.[i + tab.len - 1] in
	if tab.orig.[tab.len - 1] = c &&
	  equal_at tab.orig tab.len hay hlen i 0 then
	  i	  
	else 
	  do_index tab hay hlen (i + tab.skips.(Char.code c))
    end else
      raise Not_found
    
  let index_from tab str i =
    let hlen = String.length str in
      if i < 0 || hlen <= i then
	raise (Invalid_argument "StrExtras.FastSearch.index_from");
      do_index tab str hlen i

  let index tab str = index_from tab str 0

end

let replace str old rep =
  let b = Buffer.create (String.length str) 
  and olen = String.length old 
  and n = ref 0 in
    try
      while true do
	let pos = index_substr_from old str !n in
	  Buffer.add_substring b str !n (pos - !n);
	  Buffer.add_string b rep;
	  n := pos + olen
      done;
      (* Never reached *) ""
    with Not_found ->
      Buffer.add_substring b str !n (String.length str - !n);
      Buffer.contents b        

let of_array arr = 
  let str = String.create (Array.length arr) in
    Array.iteri (fun i c -> str.[i] <- c) arr;
    str

let to_array str = Array.init (String.length str) (function i -> str.[i])

let rec shared_prefix pref = function
  | [] -> true
  | car :: [] -> prefix pref car
  | car :: cdr ->
      if prefix pref car then
	shared_prefix pref cdr
      else 
	false

let rec find_prefixes len strs =
  if len = 0 then 
    ""
  else 
    let first = String.sub (List.hd strs) 0 len in
      if shared_prefix first strs then
	first
      else 
	find_prefixes (len - 1) strs
	  
let common_prefix = function
  | [] -> ""
  | car :: [] -> car
  | car :: cdr ->
      let minlen = List.fold_left (fun len s -> min len (String.length s))
		     (String.length car) cdr in
	find_prefixes minlen (car :: cdr)

let ensure_range f s start len =
  let stop = start + len in
  let rec ensure2 i  =
    if i >= stop then
      true
    else if f s.[i] then
      ensure2 (i + 1)
    else
      false in
    ensure2 start
      
let ensure f s =
  ensure_range f s 0 (String.length s)