Source

screentime-monitor / with_format.ml

Full commit
open Core.Std
open Async.Std

type 'a t =
  { value: 'a; format: string }
with sexp, bin_io

let sexp_of_t _ t = Sexp.Atom t.format

let t_of_sexp a_of_sexp (sexp:Sexp.t) =
  match sexp with
  | List _ -> of_sexp_error "with_format should be stored as atom, list found" sexp
  | Atom format ->
    let quoted_sexp =
      try Sexp.of_string (String.strip format)
      with e -> of_sexp_error_exn e sexp
    in
    let value = a_of_sexp quoted_sexp in
    { value; format }

let format t = t.format

let create (type a) (module T : Sexpable with type t = a) value =
  { value; format = T.sexp_of_t value |> Sexp.to_string_hum }

let load (type a) ?default filename (module T : Sexpable with type t = a) =
  Sys.file_exists_exn filename
  >>= fun exists ->
  if not exists then 
    match default with
    | None -> return (error "File not found" filename String.sexp_of_t)
    | Some default -> 
      let value = default () in
      let format = T.sexp_of_t value |> Sexp.to_string_hum in
      return (Ok { value; format} )
  else (
    try_with (fun () -> Reader.file_contents filename)
    >>|
    function
    | Error exn -> Error (Error.of_exn exn)
    | Ok format ->
      printf "%s\n" format;
      match Or_error.try_with (fun () -> 
          Sexp.of_string_conv (String.strip format) T.t_of_sexp)
      with
      | Error _ as err -> err
      | Ok (`Result value) -> Ok { value; format }
      | Ok (`Error (exn,annotated)) ->
        Error (Error.of_exn (Sexp.Annotated.get_conv_exn annotated
                               ~file:""
                               ~exc:exn))

  )

let save t filename =
  Writer.save filename ~contents:t.format

let get t = t.value