Source file conex_unix_provider.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
open Conex_utils
open Conex_unix_persistency
open Conex_io

let fs_provider basedir =
  (if not (exists basedir) then
     mkdir basedir
   else
     Ok ()) >>= fun () ->
  let get path = path_to_string (basedir :: path) in
  let ensure_dir path =
    let rec mkdir base = function
      | [] -> Ok ()
      | [_] -> Ok ()
      | x::xs ->
         let path = base @ [x] in
         let str = path_to_string path in
         (if not (exists str) then
            Conex_unix_persistency.mkdir (path_to_string path)
          else Ok ()) >>= fun () ->
         file_type str >>= function
         | Directory -> mkdir path xs
         | File -> Error (str ^ " is not a directory")
    in
    mkdir [basedir] path
  in
  let file_type path =
    let p = get path in
    file_type p
  and read path =
    let fn = get path in
    read_file fn
  and write path data =
    ensure_dir path >>= fun () ->
    let nam = get path in
    write_replace nam data
  and read_dir path =
    let abs = get path in
    collect_dir abs >>= fun files ->
    foldM (fun acc fn ->
        let fullfn = Filename.concat abs fn in
        file_type fullfn >>= function
        | File -> Ok ((File, fn) :: acc)
        | Directory -> Ok ((Directory, fn) :: acc))
      [] files
  and exists path =
    exists (get path)
  in
  Ok { basedir ; description = "File system provider" ; file_type ; read ; write ; read_dir ; exists }

let fs_ro_provider basedir =
  fs_provider basedir >>= fun fs ->
  let write _ _ = Ok ()
  and description = "Read only file system provider"
  in
  Ok { fs with description ; write }