Source

amall / src / uri.ml

Full commit
open Printf
;

open Uri_type
;


type uri = Uri_type.uri
 and authority = Uri_type.authority
 and host_kind = Uri_type.authority
;



value dump_host_kind hk =
  match hk with
  [ Reg_name -> "Reg_name"
  | IPv4address -> "IPv4address"
  | IP_literal -> "IP_literal"
  ]
;

value dump_optstr os =
  match os with
  [ None -> "None"
  | Some s -> sprintf "%S" s
  ]
;

value dump_authority a =
  sprintf "{ host_kind=%s host=%S port=%s userinfo=%s }"
    (dump_host_kind a.host_kind)
    a.host
    (match a.port with
     [ None -> "None"
     | Some p -> string_of_int p
     ])
    (dump_optstr a.userinfo)
;

value dump_uri uri =
  sprintf "{ scheme=%s authority=%s path=%S query=%s fragment=%s }"
     (dump_optstr uri.scheme)
     (match uri.authority with
      [ None -> "None"
      | Some a -> (dump_authority a)
      ])
     uri.path
     (dump_optstr uri.query)
     (dump_optstr uri.fragment)
;


value parse_gen f str =
  try Some (f (Lexing.from_string str)) with [ _ -> None ]
;


value parse u = parse_gen Urilex.uri u
;


value seg_of_path path =
  let spl = Am_String.String.split_exact ( ( = ) '/' ) path in
  inner spl
  where rec inner spl =
    match spl with
    [ [ "" ] -> spl
    | [ "" :: tl ] -> inner tl
    | _ -> spl
    ]
;


value normalize_seg segs =
  if List.exists (fun s -> s = "." || s = "..") segs
  then
    inner [] segs
    where rec inner acc = fun
      [ [] -> List.rev acc
      | ["." :: tl] -> inner acc tl
      | [".." :: tl] ->
          let new_acc =
            match acc with
            [ [] -> []
            | [_ :: tl] -> tl
            ]
          in
            inner new_acc tl
      | [hd :: tl] -> inner [hd :: acc] tl
      ]
  else
    segs
;


value normseg_of_path path =
  normalize_seg (seg_of_path path)
;

value normseg_of_uri uri = normseg_of_path uri.path
;


value parse_host_portopt s =
  parse_gen Urilex.host_portopt s
;


value parse_params s =
  Urilex.query_params [] (Buffer.create 20) (Lexing.from_string s)
;