Source file `runtime.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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
(* YOCaml a static blog generator.
   Copyright (C) 2024 The Funkyworkers and The YOCaml's developers

   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 <https://www.gnu.org/licenses/>. *)

let to_kv_path x =
  let _, r = Yocaml.Path.to_pair x in
  Mirage_kv.Key.v (r |> String.concat Filename.dir_sep)

module Make
    (Source : Required.SOURCE)
    (Config : Required.CONFIG)
    (Store : Mirage_kv.RW with type t = Git_kv.t) =
struct
  module Runtime = struct
    type 'a t = 'a Lwt.t

    let bind f x = Lwt.bind x f
    let return = Lwt.return
    let log ?src level message = Source.lift @@ Source.log ?src level message

    type runtime_error =
      | Git of Yocaml_runtime.Error.common
      | Source of Source.runtime_error

    let store = Config.store

    let runtime_error_to_string = function
      | Git err -> Yocaml_runtime.Error.common_to_string err
      | Source err -> Source.runtime_error_to_string err

    let lift_result x =
      x
      |> Source.bind (function
           | Ok x -> Source.return @@ Ok x
           | Error err -> Source.return @@ Error (Source err))
      |> Source.lift

    let map_error f_err = function
      | Ok x -> Ok x
      | Error err -> Error (Git (f_err err))

    let hash_content x = Source.lift @@ Source.hash_content x
    let get_time () = Source.lift @@ Source.get_time ()

    let file_exists ~on path =
      match on with
      | `Source -> Source.lift @@ Source.file_exists ~on path
      | `Target ->
          let open Lwt.Syntax in
          let+ exists = Store.exists store (to_kv_path path) in
          exists |> Result.fold ~ok:Option.is_some ~error:(Fun.const false)

    let read_file ~on path =
      match on with
      | `Source -> lift_result @@ Source.read_file ~on path
      | `Target ->
          let open Lwt.Syntax in
          let+ content = Store.get store (to_kv_path path) in
          map_error
            (Fun.const @@ Yocaml_runtime.Error.Unable_to_read_file path)
            content

    let get_mtime ~on path =
      match on with
      | `Source -> lift_result @@ Source.get_mtime ~on path
      | `Target ->
          let open Lwt.Syntax in
          let+ mtime = Store.last_modified store (to_kv_path path) in
          mtime
          |> Result.map (fun x -> x |> Ptime.to_float_s |> Float.to_int)
          |> map_error
               (Fun.const @@ Yocaml_runtime.Error.Unable_to_read_file path)

    let create_directory ~on path =
      match on with
      | `Source -> lift_result @@ Source.create_directory ~on path
      | `Target ->
          (* Path are Keys in Git_kv so [create_dir] is useless*)
          Lwt.return @@ Ok ()

    let write_file ~on path content =
      match on with
      | `Source -> lift_result @@ Source.write_file ~on path content
      | `Target ->
          let open Lwt.Syntax in
          let+ result = Store.set store (to_kv_path path) content in
          map_error
            (Fun.const @@ Yocaml_runtime.Error.Unable_to_read_file path)
            result

    let erase_file ~on path =
      match on with
      | `Source -> lift_result @@ Source.erase_file ~on path
      | `Target ->
          let open Lwt.Infix in
          Store.remove store (to_kv_path path)
          >|= map_error
                (Fun.const @@ Yocaml_runtime.Error.Unable_to_erase_file path)

    let is_directory ~on path =
      match on with
      | `Source -> Source.lift @@ Source.is_directory ~on path
      | `Target ->
          let open Lwt.Infix in
          Store.exists store (to_kv_path path)
          >|= Result.fold
                ~ok:(function Some `Dictionary -> true | _ -> false)
                ~error:(Fun.const false)

    let is_file ~on path =
      match on with
      | `Source -> Source.lift @@ Source.is_file ~on path
      | `Target ->
          let open Lwt.Infix in
          Store.exists store (to_kv_path path)
          >|= Result.fold
                ~ok:(function Some `Value -> true | _ -> false)
                ~error:(Fun.const false)

    let exec ?is_success prog args =
      lift_result @@ Source.exec ?is_success prog args

    let read_dir ~on path =
      match on with
      | `Source -> lift_result @@ Source.read_dir ~on path
      | `Target ->
          (* Should be used on the source side *)
          Lwt.return @@ Ok []
  end

  module Runner = Yocaml.Runtime.Make (Runtime)
  include Runtime
end