Commits

Yaron Minsky committed 3452c3b

added with_format

Comments (0)

Files changed (2)

+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
+open Core.Std
+open Async.Std
+
+(** A wrapper for keeping an object along with the raw-text
+    representation of its s-expression *)
+
+type 'a t with sexp, bin_io
+
+val format : 'a t -> string
+val create 
+  :  (module Sexpable with type t = 'a)
+  -> 'a
+  -> 'a t
+
+val load
+  :  ?default:(unit -> 'a)
+  -> string
+  -> (module Sexpable with type t = 'a)
+  -> 'a t Deferred.Or_error.t
+val save : 'a t -> string -> unit Deferred.t
+val get : 'a t -> 'a