2 files changed, 43 insertions, 0 deletions
diff --git a/lib/concepts/Condition.ml b/lib/concepts/Condition.ml
new file mode 100644
index 0000000..cc0f7a7
--- /dev/null
+++ b/lib/concepts/Condition.ml
@@ -0,0 +1,29 @@
+type properties = (string, Value.value) BatMap.t
+type ps = properties -> properties
+
+type condition =
+  {name: string; message: string; backtrace: Printexc.raw_backtrace; properties: properties}
+
+let ( |=| ) name value = fun p -> BatMap.add name value p
+let ( & ) l r = fun p -> r (l p)
+let empty = fun p -> p
+
+let condition name message ?parent props =
+  { name;
+    message;
+    backtrace= Printexc.get_callstack 256;
+    properties=
+      parent
+      |> Option.map (fun {properties; _} -> properties)
+      |> Option.value ~default:BatMap.empty
+      |> props }
+
+let to_string_hum {name; message; properties; backtrace} =
+  let properties' =
+    properties
+    |> BatMap.to_seq
+    |> BatSeq.to_string ~first:"" ~last:"" ~sep:"\n" (fun (k, v) ->
+        "\t" ^ k ^ ": " ^ Value.to_string v )
+  in
+  let backtrace' = Printexc.raw_backtrace_to_string backtrace in
+  name ^ ": " ^ message ^ "\n" ^ properties' ^ "\n\nBacktrace:\n" ^ backtrace'
diff --git a/lib/concepts/Condition.mli b/lib/concepts/Condition.mli
new file mode 100644
index 0000000..fba43e6
--- /dev/null
+++ b/lib/concepts/Condition.mli
@@ -0,0 +1,14 @@
+(** an abstract type representing an error condition *)
+type condition
+
+type ps
+
+val ( |=| ) : string -> Value.value -> ps
+val ( & ) : ps -> ps -> ps
+val empty : ps
+
+(** construct a condition out of a name, a message, a set of properties and an optional parent *)
+val condition : string -> string -> ?parent:condition -> ps -> condition
+
+(** print a condition to a human-readable string *)
+val to_string_hum : condition -> string