Use structural typeclasses for result module

Author: mlms13

docs/decoding-variants.md

@@ -28,7 +28,7 @@ D.variantFromString(parseColor, Js.Json.string("Yellow"));
 
 In other cases, `ExpectedValidOption` might not be enough debugging information. You may want custom handling (or simply more specific errors) when something goes wrong during decoding.
 
-You can get this by extending the underlying `DecodeBase.failure` type with extra constructors. You use this extension to build your own custom `Decode.ParseError`, which in turn can be used to build a custom decode module on top of `DecodeBase`.
+You can get this by extending the underlying `Decode.ParseError.base` type with extra constructors. You use this extension to build your own custom `Decode.ParseError`, which in turn can be used to build a custom decode module on top of `DecodeBase`.
 
 This may sound overwhelming, but the whole thing can be accomplished in about 6 lines of code:
 

src/Decode_AsResult_OfParseError.re

@@ -1,10 +1,10 @@
 module NonEmptyList = Relude.NonEmpty.List;
 module ParseError = Decode_ParseError;
 
-module ResultUtil =
+module Result =
   ParseError.ResultOf({
     type t = ParseError.base;
     let handle = t => t;
   });
 
-include DecodeBase.DecodeBase(ResultUtil.TransformError, ResultUtil.Monad);
+include DecodeBase.DecodeBase(Result.TransformError, Result);

src/Decode_AsResult_OfStringNel.re

@@ -6,22 +6,21 @@ open Relude.Globals;
 module NonEmptyList = NonEmpty.List;
 
 module ResultUtil = {
-  open BsAbstract.Interface;
   module ParseError = Decode_ParseError;
+  type t('a) = result('a, NonEmptyList.t(string));
 
-  module Monad: MONAD with type t('a) = result('a, NonEmptyList.t(string)) = {
-    type t('a) = result('a, NonEmptyList.t(string));
-    let map = Result.map;
-    let apply = (a, b) =>
-      switch (a, b) {
-      | (Ok(f), Ok(v)) => Ok(f(v))
-      | (Ok(_), Error(v)) => Error(v)
-      | (Error(v), Ok(_)) => Error(v)
-      | (Error(xa), Error(xb)) => Error(NonEmptyList.concat(xa, xb))
-      };
-    let pure = Result.pure;
-    let flat_map = Result.bind;
-  };
+  let map = Result.map;
+
+  let apply = (a, b) =>
+    switch (a, b) {
+    | (Ok(f), Ok(v)) => Ok(f(v))
+    | (Ok(_), Error(v)) => Error(v)
+    | (Error(v), Ok(_)) => Error(v)
+    | (Error(xa), Error(xb)) => Error(NonEmptyList.concat(xa, xb))
+    };
+
+  let pure = Result.pure;
+  let flat_map = Result.bind;
 
   module Transform:
     ParseError.TransformError with
@@ -54,4 +53,4 @@ module ResultUtil = {
   };
 };
 
-include DecodeBase.DecodeBase(ResultUtil.Transform, ResultUtil.Monad);
+include DecodeBase.DecodeBase(ResultUtil.Transform, ResultUtil);

src/Decode_ParseError.re

@@ -152,26 +152,22 @@ module type ValError = {
 };
 
 module ResultOf = (Err: ValError) => {
-  open BsAbstract.Interface;
-
-  type r('a) = Result.t('a, t(Err.t));
-
-  module Monad: MONAD with type t('a) = r('a) = {
-    type t('a) = r('a);
-    let map = Result.map;
-    let apply = (f, v) =>
-      switch (f, v) {
-      | (Ok(fn), Ok(a)) => Result.ok(fn(a))
-      | (Ok(_), Error(_) as err) => err
-      | (Error(_) as err, Ok(_)) => err
-      | (Error(fnx), Error(ax)) => Result.error(combine(fnx, ax))
-      };
-    let pure = Result.pure;
-    let flat_map = Result.bind;
-  };
+  type error = t(Err.t);
+  type nonrec t('a) = result('a, error);
+  let map = Result.map;
+  let apply = (f, v) =>
+    switch (f, v) {
+    | (Ok(fn), Ok(a)) => Result.ok(fn(a))
+    | (Ok(_), Error(_) as err) => err
+    | (Error(_) as err, Ok(_)) => err
+    | (Error(fnx), Error(ax)) => Result.error(combine(fnx, ax))
+    };
+
+  let pure = Result.pure;
+  let flat_map = Result.bind;
 
-  module TransformError: TransformError with type t('a) = r('a) = {
-    type t('a) = r('a);
+  module TransformError: TransformError with type t('a) = result('a, error) = {
+    type t('a) = result('a, error);
 
     let valErr = (v, json) => Result.error(Val(Err.handle(v), json));
     let arrErr = pos => Result.mapError(arrPure(pos));

src/Decode_ParseError.rei

@@ -49,16 +49,15 @@ module type ValError = {
 module ResultOf:
   (Err: ValError) =>
    {
-    module Monad: {
-      type nonrec t('a) = result('a, t(Err.t));
-      let map: ('a => 'b, t('a)) => t('b);
-      let apply: (t('a => 'b), t('a)) => t('b);
-      let pure: 'a => t('a);
-      let flat_map: (t('a), 'a => t('b)) => t('b);
-    };
+    type error = t(Err.t);
+    type nonrec t('a) = result('a, error);
+    let map: ('a => 'b, t('a)) => t('b);
+    let apply: (t('a => 'b), t('a)) => t('b);
+    let pure: 'a => t('a);
+    let flat_map: (t('a), 'a => t('b)) => t('b);
 
     module TransformError: {
-      type nonrec t('a) = result('a, t(Err.t));
+      type nonrec t('a) = result('a, error);
       let valErr: (base, Js.Json.t) => t('a);
       let arrErr: (int, t('a)) => t('a);
       let missingFieldErr: string => t('a);

test/Decode_AsOption_test.re

@@ -531,7 +531,7 @@ describe("Decode records", () => {
 [@bs.module] external bigjson: Js.Json.t = "./utils/BigJson.json";
 
 describe("Big JSON array", () =>
-  test("Doesn't blow up", () =>
+  test("is stack-safe", () =>
     expect(Decode.array(Option.pure, bigjson) |> Option.isSome)
     |> toEqual(true)
   )

test/Decode_AsResult_OfCustom_test.re

@@ -11,17 +11,14 @@ module Sample = Decode_TestSampleData;
 
 type customError = [ ParseError.base | `InvalidColor | `InvalidShape];
 
-module ResultOfCustomError =
+module ResultCustom =
   Decode.ParseError.ResultOf({
     type t = customError;
     let handle = x => (x :> t);
   });
 
 module Decode =
-  DecodeBase.DecodeBase(
-    ResultOfCustomError.TransformError,
-    ResultOfCustomError.Monad,
-  );
+  DecodeBase.DecodeBase(ResultCustom.TransformError, ResultCustom);
 
 let toDebugString = (err, json) =>
   switch (err) {