1 files changed, 121 insertions, 0 deletions
diff --git a/lib/utils.ml b/lib/utils.ml
new file mode 100644
index 0000000..00e003a
--- /dev/null
+++ b/lib/utils.ml
@@ -0,0 +1,121 @@
+module Decoder : sig
+  type 'a decoder
+
+  val decode : 'a decoder -> Yojson.Safe.t -> 'a option
+  val return : 'a -> 'a decoder
+  val fail : 'a decoder
+  val bind : 'a decoder -> ('a -> 'b decoder) -> 'b decoder
+  val map : ('a -> 'b) -> 'a decoder -> 'b decoder
+  val string : string decoder
+  val literal : string -> string decoder
+  val int : int decoder
+  val field : string -> 'a decoder -> 'a decoder
+  val list : 'a decoder -> 'a list decoder
+  val one_of : 'a decoder list -> 'a decoder
+
+  module Syntax : sig
+    val ( *> ) : 'a decoder -> 'b decoder -> 'b decoder
+    val ( <* ) : 'a decoder -> 'b decoder -> 'a decoder
+    val ( >>= ) : 'a decoder -> ('a -> 'b decoder) -> 'b decoder
+    val ( >>| ) : 'a decoder -> ('a -> 'b) -> 'b decoder
+    val ( <*> ) : ('a -> 'b) decoder -> 'a decoder -> 'b decoder
+    val ( <$> ) : ('a -> 'b) -> 'a decoder -> 'b decoder
+    val ( <: ) : string -> 'a decoder -> 'a decoder
+    val ( <|> ) : 'a decoder -> 'a decoder -> 'a decoder
+  end
+end = struct
+  type 'a decoder = Yojson.Safe.t -> 'a option
+
+  let decode decoder json = decoder json
+  let return v _ = Some v
+  let fail _ = None
+
+  let map f decoder json =
+    match decoder json with
+    | Some d -> Some (f d)
+    | None -> None
+  ;;
+
+  let bind decoder f json =
+    match decoder json with
+    | Some x -> f x `Null
+    | None -> None
+  ;;
+
+  let rec one_of decoders json =
+    match decoders with
+    | [] -> None
+    | decoder :: tl ->
+      (match decoder json with
+       | Some _ as x -> x
+       | None -> one_of tl json)
+  ;;
+
+  let string = function
+    | `String str -> Some str
+    | _ -> None
+  ;;
+
+  let literal str = function
+    | `String s when String.equal s str -> Some s
+    | _ -> None
+  ;;
+
+  let int = function
+    | `Int int -> Some int
+    | _ -> None
+  ;;
+
+  let field key decoder json =
+    try decoder @@ Yojson.Safe.Util.member key json with
+    | _ -> None
+  ;;
+
+  let list decoder json =
+    let rec helper acc = function
+      | [] -> Some []
+      | hd :: tl ->
+        (match decoder hd with
+         | Some _ as x -> helper (x :: acc) tl
+         | None -> None)
+    in
+    match json with
+    | `List list -> Option.map List.rev (helper [] list)
+    | _ -> None
+  ;;
+
+  module Syntax = struct
+    let ( *> ) decoder_a decoder_b yojson =
+      match decoder_a yojson with
+      | Some _ -> decoder_b yojson
+      | None -> None
+    ;;
+
+    let ( <* ) decoder_a decoder_b yojson =
+      match decoder_a yojson with
+      | Some value -> Option.map (fun _ -> value) (decoder_b yojson)
+      | None -> None
+    ;;
+
+    let ( >>= ) = bind
+    let ( >>| ) decoder f yojson = map f decoder yojson
+
+    let ( <*> ) decoder_a decoder_b input =
+      match decoder_a input with
+      | Some f ->
+        (match decoder_b input with
+         | Some x -> Some (f x)
+         | None -> None)
+      | None -> None
+    ;;
+
+    let ( <$> ) f decoder = decoder >>| f
+    let ( <: ) = field
+
+    let ( <|> ) decoder_a decoder_b input =
+      match decoder_a input with
+      | Some _ as value -> value
+      | None -> decoder_b input
+    ;;
+  end
+end