Something went wrong. Try again.
Git-native issue tracker
Something went wrong. Try again.
3.2 kB · 93 lines
OCaml
at main
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394module C = Json.Codec
type t = { id : string; author : string; created_at : string; body : string }
let id t = t.idlet author t = t.authorlet created_at t = t.created_atlet body t = t.body
let equal a b = String.equal a.id b.id && String.equal a.author b.author && String.equal a.created_at b.created_at && String.equal a.body b.body
let filename t = t.id ^ ".md"let per_directory = 128let most = per_directory * per_directory
let path ~index t = if index < 0 || index >= most then Fmt.error "comment index %d is outside 0 to %d" index (most - 1) else Ok [ "comments"; Fmt.str "%03d" (index / per_directory); Fmt.str "%05d-%s" index (filename t); ]
let valid_id id = String.length id > 0 && id <> "." && id <> ".." && String.for_all (function | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' | '.' -> true | _ -> false) id
let content_id ~author ~body = let digest = Cas.Hash.(to_hex (sha256 (author ^ "\000" ^ body))) in "c-" ^ String.sub digest 0 24
let v ~id ~author ~created_at ~body = if not (valid_id id) then Error ("invalid comment id " ^ id) else Ok { id; author; created_at; body }
type header = { author : string; created_at : string }
let header_codec = C.Object.map (fun author created_at -> { author; created_at }) |> C.Object.member "author" C.string ~enc:(fun h -> h.author) |> C.Object.member "created_at" C.string ~enc:(fun h -> h.created_at) |> C.Object.error_unknown |> C.Object.seal
let to_blob (t : t) = Json.to_string header_codec { author = t.author; created_at = t.created_at } ^ "\n\n" ^ t.body
let digits n s = String.length s = n && String.for_all (function '0' .. '9' -> true | _ -> false) s
(* The index and the file name of [group/file], when it is a comment's path by {!path}. *)let index_of_path ~group file = match String.index_opt file '-' with | Some 5 when digits 3 group && digits 5 (String.sub file 0 5) -> let index = int_of_string (String.sub file 0 5) in let name = String.sub file 6 (String.length file - 6) in if index / per_directory = int_of_string group then Some (index, name) else None | _ -> None
let of_blob ~filename blob = let suffix = ".md" in let n = String.length filename in if n <= String.length suffix || not (Filename.check_suffix filename suffix) then Error ("invalid comment filename " ^ filename) else let id = String.sub filename 0 (n - String.length suffix) in if not (valid_id id) then Error ("invalid comment filename " ^ filename) else match String.index_opt blob '\n' with | None -> Error (filename ^ ": missing header separator") | Some at when at + 1 >= String.length blob || blob.[at + 1] <> '\n' -> Error (filename ^ ": missing blank line after header") | Some at -> ( let header = String.sub blob 0 at in let body = String.sub blob (at + 2) (String.length blob - at - 2) in match Json.of_string header_codec header with | Error error -> Error (filename ^ ": " ^ Json.Error.to_string error) | Ok { author; created_at } -> v ~id ~author ~created_at ~body)