seppo/test/t_file.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * Copyright (C) The #Seppo contributors. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program 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 General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open Seppo_lib
open Alcotest

let set_up = "setup", `Quick, (fun () ->  
    Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
    Unix.chdir "../../../test/"
  )

(*
let cp' ?(buf = 16 * 0x400 |> Bytes.create) src oc =
  let ic = open_in_gen [ Open_rdonly; Open_binary ] 0 src in
  ic |> copy_channel ~buf oc;
  close_in ic
*)

let tc_www_base = "tc_www_base", `Quick, (fun () ->
    (match
       "/a/b/c"
       |> String.split_on_char '/'
       |> List.rev
       |> List.cons "."
     with
     | [ d; c; b; a; v ] ->
       v |> Assrt.equals_string __LOC__ "";
       a |> Assrt.equals_string __LOC__ "a";
       b |> Assrt.equals_string __LOC__ "b";
       c |> Assrt.equals_string __LOC__ "c";
       d |> Assrt.equals_string __LOC__ ".";
     | _ ->
       "woring" |> Assrt.equals_string __LOC__ "");
    (match
       "/a/b/c"
       |> String.split_on_char '/'
       |> List.rev
       |> File.find_path_tail (fun s -> Ok (s |> String.equal "/b/c"))
     with
     | Ok s -> s |> Assrt.equals_string __LOC__ "/b/c"
     | Error e -> e |> Assrt.equals_string __LOC__ "");
    let wefi u =
      let wkwf =  ".well-known/webfinger/" in
      let i = u |> Uri.path |> String.split_on_char '/' |> List.length in
      ((List.init (i-2) (fun _ -> "../") |> String.concat "") ^ wkwf)
    in
    "https://ursi@demo.mro.name/" |> Uri.of_string 
    |> wefi |> Assrt.equals_string __LOC__ ".well-known/webfinger/";
    "https://ursi@demo.mro.name/seppo/" |> Uri.of_string 
    |> wefi |> Assrt.equals_string __LOC__ "../.well-known/webfinger/"
  )

module Path = struct
  let tc_climb = "tc_climb", `Quick, (fun () ->
      let u = Uri.make ~scheme:"https" ~userinfo:"foo" ~host:"example.com" ~path:"/a/b/c/" () in
      u |> Uri.path |> Assrt.equals_string __LOC__ "/a/b/c/";
      let i = u |> Uri.path |> String.split_on_char '/' |> List.length in
      List.init (i-2) (fun _ -> "..") |> String.concat "/"
      |> Assrt.equals_string __LOC__ "../../..";
      "z" |> Assrt.equals_string __LOC__ "z"
    )

  let tc_hd_tl = "tc_hd_tl", `Quick, (fun () ->
      "/foo/bar/baz"
      |> File.Path.hd '/'
      |> Option.get |> Assrt.equals_string __LOC__ "";
      let t0 = "/foo/bar/baz" |> File.Path.tl '/' |> Option.get in
      t0 |> Assrt.equals_string __LOC__ "foo/bar/baz";
      t0 |> File.Path.hd '/'
      |> Option.get |> Assrt.equals_string __LOC__ "foo";
      let t1 = t0 |> File.Path.tl '/' |> Option.get in
      t1 |> Assrt.equals_string __LOC__ "bar/baz";
      let t2 = t1 |> File.Path.tl '/' |> Option.get in
      t2 |> Assrt.equals_string __LOC__ "baz";
      assert (t2 |> File.Path.tl '/' |> Option.is_none);
      assert true
    )
end

let tc_out_channel_atomic = "tc_out_channel_atomic", `Quick, (fun () ->
    "tmp/a.txt" |> File.out_channel_append (fun oc -> output_string oc "huhu");
    "tmp/b.txt" |> File.out_channel_replace (fun oc -> output_string oc "huhu");
    "tmp/c.txt" |> File.out_channel_replace ~mode:[Open_binary;Open_creat;Open_excl;Open_trunc;Open_wronly] (fun oc -> output_string oc "huhu");
    "" |> Assrt.equals_string __LOC__ ""
  )

let () =
  run
    "seppo_suite" [
    __FILE__ , [ 
      set_up;
      tc_www_base;
      Path.tc_climb;
      Path.tc_hd_tl;
      tc_out_channel_atomic;
    ]
  ];
  assert true