Source

amall / src / am_String.ml

Full commit
module String
 =
  struct

    include String
    ;

    value is_prefix ~string ~prefix =
      let str_len = String.length string
      and pref_len = String.length prefix in
      pref_len <= str_len
      && String.sub string 0 pref_len = prefix
    ;

    value chop_prefix ~string ~prefix =
      let pref_len = String.length prefix in
      if is_prefix ~string ~prefix
      then String.sub string pref_len (String.length string - pref_len)
      else string
    ;

    value is_suffix ~string ~suffix =
      let str_len = String.length string
      and suf_len = String.length suffix in
      suf_len <= str_len &&
      String.sub string (str_len - suf_len) suf_len = suffix
    ;

    value chop_suffix ~string ~suffix =
      let suf_len = String.length suffix in
      if is_suffix ~string ~suffix
      then String.sub string 0 (String.length string - suf_len)
      else string
    ;

    value trim_count pred s =
      let len = String.length s in
      let first_skipping =
        inner 0
        where rec inner i =
          if i = len || not (pred s.[i])
          then i
          else inner (i + 1)
      in
        if first_skipping = len
        then (len, "", 0)
        else
          let last_leaving =
            inner (len - 1)
            where rec inner i =
              let () = assert (i >= first_skipping) in
              if pred s.[i]
              then inner (i - 1)
              else i
          in
            let new_len = last_leaving - first_skipping + 1 in
            ( first_skipping
            , if new_len = len
              then s
              else String.sub s first_skipping new_len
            , len - last_leaving - 1
            )
    ;

    value trim pred s =
      let (_firsts, res, _lasts) = trim_count pred s in
      res
    ;

    value split_by_first pred s =
      let len = String.length s in
      let i =
        inner 0
        where rec inner i =
          if i = len || pred s.[i]
          then i
          else inner (i + 1)
      in
        if i = len
        then (s, "", "")
        else
          ( String.sub s 0 i
          , String.sub s i 1
          , String.sub s (i + 1) (len - i - 1)
          )
    ;


    (* [split_exact ((=) '.') ".asd..sdf." = ["";"asd";"";"sdf";""]] *)
    value split_exact pred s =
      let len = String.length s in

      let rec rev_delimiters rev_acc i =  (* including -1 and len *)
        if i = len
        then [len :: rev_acc]
        else
        if pred s.[i]
        then
          rev_delimiters [i :: rev_acc] (i + 1)
        else
          rev_delimiters rev_acc (i + 1)
      in
      let rev_dels = rev_delimiters [-1] 0 in
      let rec inner acc rev_dels =
        match rev_dels with
        [ [] -> assert False
        | [ _ :: [] ] -> acc
        | [next :: ([this :: _] as tl)] ->
            inner
              [(String.sub s (this+1) (next - this - 1)) :: acc]
              tl
        ]
      in
        inner [] rev_dels
    ;


(*
    value () =
      if split_exact ((=) '.') ".asd..sdf." = ["";"asd";"";"sdf";""]
         && split_exact ((=) '.') "" = [""]
         && split_exact ((=) '.') "asd" = ["asd"]
      then failwith "ok"
      else failwith "bad"
    ;
*)


    (* todo: more effective implementation. *)

    value split pred s =
      List.filter ((<>) "") (split_exact pred s)
    ;


    value decode_hex_opt ch =
      let c = Char.code ch in
      if ch >= '0' && ch <= '9'
      then Some (c - (Char.code '0'))
      else if ch >= 'A' && ch <= 'F'
      then Some (c - (Char.code 'A') + 10)
      else if ch >= 'a' && ch <= 'f'
      then Some (c - (Char.code 'a') + 10)
      else None
    ;


    value urldecode s =
      let len = String.length s in
      let buf = Buffer.create (len / 3) in
      loop 0
      where rec loop i =
        if i = len
        then Buffer.contents buf
        else
          let out ch adv =
            (Buffer.add_char buf ch; loop (i + adv))
          in
          match s.[i] with
          [ '+' -> out '\x20' 1
          | '%' as c0 ->
              if i + 2 >= len
              then out c0 1
              else
                let c1 = s.[i + 1]
                and c2 = s.[i + 2] in
                match (decode_hex_opt c1, decode_hex_opt c2) with
                [ (Some d1, Some d2) ->
                    out (Char.chr (16*d1 + d2)) 3
                | _ -> out c0 1
                ]
          | c -> out c 1
          ]
    ;


    (* todo: more effective implementation *)

    value concat_array sep str_arr =
      String.concat sep (Array.to_list str_arr)
    ;


    value explode str =
      inner [] (String.length str - 1)
      where rec inner acc i =
        if i < 0
        then acc
        else inner [str.[i] :: acc] (i - 1)
    ;


    value compare_nocase_latin1 s1 s2 =
      let len1 = String.length s1 in
      let len2 = String.length s2 in
      let bound = min len1 len2 in
      loop 0
      where rec loop i =
        if i = bound
        then
          Pervasives.compare len1 len2
        else
          match Pervasives.compare
            (Char.uppercase s1.[i]) (Char.uppercase s2.[i])
          with
          [ 0 -> loop (i + 1)
          | r -> r
          ]
    ;


    value eq a b =
      let len = length a in
      if len <> length b
      then False
      else
        loop 0
        where rec loop i =
          if i = len
          then True
          else
            if (unsafe_get a i) = (unsafe_get b i)
            then loop (i + 1)
            else False
    ;


  end
;